Retrieve a worksheet based on the worksheet contents

 2011-07-21    Worksheets    1    293

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