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 SubThe 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