Excel Find a sheet based on name

Question

This is not a question, so much as a solution, but I wanted to share it here as I had gotten help for things I needed here.

I wanted to find a specific Excel sheet, in the Active Workbook, searching by the name of the sheet. I built this to find it. It is a "contains" search, and will automatically go to the sheet if it is found, or ask the user if there are multiple matches:

To end at any time, just enter a blank in the input box.

Public Sub Find_Tab_Search()
    Dim sSearch As String
    sSearch = ""
    sSearch = InputBox("Enter Search", "Find Tab")
    If Trim(sSearch) = "" Then Exit Sub
    'MsgBox (sSearch)

    Dim sSheets() As String
    Dim sMatchMessage As String
    Dim iWorksheets As Integer
    Dim iCounter As Integer
    Dim iMatches As Integer
    Dim iMatch As Integer
    Dim sGet As String
    Dim sPrompt As String

    iMatch = -1
    iMatches = 0
    sMatchMessage = ""

    iWorksheets = Application.ActiveWorkbook.Sheets.Count
    ReDim sSheets(iWorksheets)

    'Put list of names in array
    For iCounter = 1 To iWorksheets
        sSheets(iCounter) = Application.ActiveWorkbook.Sheets(iCounter).Name
        If InStr(1, sSheets(iCounter), sSearch, vbTextCompare) > 0 Then
            iMatches = iMatches + 1
            If iMatch = -1 Then iMatch = iCounter
            sMatchMessage = sMatchMessage + CStr(iCounter) + ": " + sSheets(iCounter) + vbCrLf
        End If
    Next iCounter

    Select Case iMatches
        Case 0
            'No Matches
            MsgBox "No Match Found for " + sSearch
        Case 1
            '1 match activate the sheet
            Application.ActiveWorkbook.Sheets(iMatch).Activate
        Case Else
            'More than 1 match. Ask them which sheet to go to
            sGet = -1
            sPrompt = "More than one match found. Please enter number from following list"
            sPrompt = sPrompt + "to display the sheet" + vbCrLf + vbCrLf + sMatchMessage
            sPrompt = sPrompt + vbCrLf + vbCrLf + "Enter blank to cancel"
            sGet = InputBox(sPrompt, "Please select one")
            If Trim(sGet) = "" Then Exit Sub
            sPrompt = "Value must be a number" + vbCrLf + vbCrLf + sPrompt
            Do While IsNumeric(sGet) = False
                sGet = InputBox(sPrompt, "Please select one")
                If Trim(sGet) = "" Then Exit Sub
            Loop
            iMatch = CInt(sGet)
            Application.ActiveWorkbook.Sheets(iMatch).Activate
    End Select

End Sub

I hope someone finds this useful, and would also welcome enhancement suggestions.

Answer 1

For fun tried to do this in as few lines as possible with loops

Uses a range name, xlm, and VBS under utilised Filter to provide the same multi-sheet search functionality as above.

The bulk of the code relates to the sheet selection portion

Sub GetNAmes()
Dim strIn As String
Dim X

strIn = Application.InputBox("Search string", "Enter string to find", ActiveSheet.Name, , , , , 2)
If strIn = "False" Then Exit Sub

ActiveWorkbook.Names.Add "shtNames", "=RIGHT(GET.WORKBOOK(1),LEN(GET.WORKBOOK(1))-FIND(""]"",GET.WORKBOOK(1)))"
X = Filter([index(shtNames,)], strIn, True, 1)

Select Case UBound(X)
    Case Is > 0
        strIn = Application.InputBox(Join(X, Chr(10)), "Multiple matches found - type position to select", , , , , 1)
        If strIn = "False" Then Exit Sub
        On Error Resume Next
        Sheets(CStr(X(strIn))).Activate
        On Error GoTo 0
    Case 0
        Sheets(X(0)).Activate
    Case Else
        MsgBox "No match"
End Select

End Sub