Retrieve a worksheet based on the worksheet contents
2011-07-21 Worksheets 1 687
Both of the function examples below can be very useful when you create a solution that is depending on input from a special worksheet. Instead of bothering the user by asking about the worksheet and workbook that contains the data source, you can use the functions below to find that special worksheet, as long as it always has some unique identifying content in one or more cells. The function below will return a worksheet object from one workbook if it finds a worksheet that contains the right values in the right cells:
Function GetWorksheetByContent(wb As Workbook, varRange As Variant, varContent As Variant) As Worksheet
' wb must be a valid workbook object
' varRange must be a valid text cell address or defined name, or an array of text cell addresses or defined names
' varContent must contain the value(s) you want to find in the worksheet cell(s)
' if varRange is an array, varContent must be an equally sized array
' if all the varRange cell values matches the varContent values the worksheet object is returned
Dim w As Long, i As Long, OK As Boolean
If wb Is Nothing Then Exit Function
If Not IsArray(varRange) Then
If Len(varRange) = 0 Then Exit Function
Else
If UBound(varRange) - LBound(varRange) + 1 < 1 Then Exit Function
If Not IsArray(varContent) Then Exit Function
If LBound(varContent) <> LBound(varRange) Then Exit Function
If UBound(varContent) <> UBound(varRange) Then Exit Function
End If
Application.StatusBar = "Looking for worksheet matching desired content in " & wb.Name & "..."
With wb
OK = False
For w = 1 To .Worksheets.Count
If Not IsArray(varRange) Then
On Error Resume Next
If .Worksheets(w).Range(varRange).Value = varContent Then
OK = True
End If
On Error GoTo 0
Else
For i = LBound(varRange) To UBound(varRange)
On Error Resume Next
If .Worksheets(w).Range(varRange(i)).Value = varContent(i) Then
OK = True
End If
On Error GoTo 0
Next i
End If
If OK Then ' all criterias matches, worksheet found
Set GetWorksheetByContent = .Worksheets(w)
w = .Worksheets.Count ' exit loop
End If
Next w
End With
Application.StatusBar = False
End Function
Sub ExampleGetWorksheetByContent()
Dim ws As Worksheet
' use one of the example lines below
'Set ws = GetWorksheetByContent(ActiveWorkbook, "A1", "ABC") ' look for a text
'Set ws = GetWorksheetByContent(ActiveWorkbook, "B1", 100) ' look for a value
Set ws = GetWorksheetByContent(ActiveWorkbook, Array("A1", "B1"), Array("ABC", 100)) ' look for multiple items
If ws Is Nothing Then Exit Sub ' worksheet not found
Debug.Print "Found Worksheet in " & ws.Parent.Name & ": " & ws.Name
Set ws = Nothing
End Sub
The function below uses the function above and will return a worksheet object from all open workbooks if it finds a worksheet that contains the right values in the right cells:
Function GetWorksheetByContentAllWB(varRange As Variant, varContent As Variant) As Worksheet
' varRange must be a valid text cell reference or an array of text cell references
' varContent must contain the value(s) you want to find int the worksheet cell(s)
Dim wb As Workbook
For Each wb In Application.Workbooks
Set GetWorksheetByContentAllWB = GetWorksheetByContent(wb, varRange, varContent)
If Not GetWorksheetByContentAllWB Is Nothing Then
Exit For
End If
Next wb
Set wb = Nothing
Application.StatusBar = False
End Function
Sub ExampleGetWorksheetByContentAllWB()
Dim ws As Worksheet
' use one of the example lines below
'Set ws = GetWorksheetByContentAllWB("A1", "ABC") ' look for a text
'Set ws = GetWorksheetByContentAllWB("B1", 100) ' look for a value
Set ws = GetWorksheetByContentAllWB(Array("A1", "B1"), Array("ABC", 100)) ' look for multiple items
If ws Is Nothing Then Exit Sub ' worksheet not found
Debug.Print "Found Worksheet in " & ws.Parent.Name & ": " & ws.Name
Set ws = Nothing
End Sub