Alphabetize worksheet list

Please try this code in place of the one you published.

Private Sub WorkSheetList()

    Const SwitchBoardName As String = "General.Switchboard"
    Const FilterCell As String = "AQ53"
    Const OutputRow As Long = 58
    Const NameClm As String = "AJ"
    Const IndexClm As String =  "AV"
    Const CodeNameClm As String = "AS"

    Dim Sb As Worksheet
    Dim Flt As String
    Dim TabNames() As String
    Dim R As Long
    Dim Ws As Worksheet
    Dim Rng As Range

    Set Sb = ThisWorkbook.Worksheets(SwitchBoardName)
    Flt = Sb.Range(FilterCell).Cells(1).Value
    ReDim TabNames(ThisWorkbook.Worksheets.Count)

    R = OutputRow
    For Each Ws In ThisWorkbook.Worksheets
        If InStr(1, Ws.Name, Flt, vbTextCompare) = 1 Then
            Sb.Cells(R, NameClm).Value = Ws.Name
            R = R + 1
        End If
    Next Ws

    If R Then                   ' R=0, if no match was found
        Set Rng = Sb.Range(Sb.Cells(OutputRow, NameClm), Sb.Cells(R - 1, NameClm))
        With Sb.Sort
            With .SortFields
                .Clear
                .Add Key:=Rng.Cells(1), _
                          SortOn:=xlSortOnValues, _
                          Order:=xlAscending, _
                          DataOption:=xlSortTextAsNumbers
            End With

            .SetRange Rng
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        With Rng
            For R = 1 To .Cells.Count
                Set Ws = ThisWorkbook.Worksheets(.Cells(R).Value)
                Sb.Cells(.Cells(R).Row, IndexClm).Value = Ws.Index
                Sb.Cells(.Cells(R).Row, CodeNameClm).Value = Ws.CodeName
            Next R
        End With
    End If
End Sub

Variatus

After seeing the complex code that actually works, I thought I would go back to you with another problem because you seem to know what you're doing.

I have another problem that started the process of updating this program (thankfully this program is just for my own use and any small problems I can deal with)

My ultimate quest is to return ALL the matches on worksheet LISTS that match all 3 criteria on the Restrictions worksheet.

My index/Match in cell 'Template.Restrictions!bs14' has gotten so complex (internet solutions) and returns just  one value down to cell 'Template.Restrictions!bs336' that I'm about to scream.

I'm using 2016 Microsoft Office the Excel program.

I've also included 2 screen shots if you can't open the file.

I made a similar worksheet on the old ExcelKey forum. You csn see ther entire explanation at http://www.excelkey.com/forum/viewtopic.php?f=5&t=3305/ Basically, it is an interactive ToC sheet that is always ;ocated next to the currently ActiveSheet. All thus code goes into that sheet's code Pane, Note that you must rename the sheet's CodeName, or edit the code, This was only tested in 97, XP, and Excel 7

Option Explicit

    

    Private Sub Worksheet_Activate()
      'An interactive index that refreshes each time it's viewed
      'so that it is always current.
      '
      'The Selection Change Sub below keeps this sheet next to
      'the Sheet chosen when the User clicks on a Sheet name
      'in the Sheet Index List.
     

      'ShtNdx is the CodeName of "Sheet Index"
      Const TopRowOfList As Long = 4 'Set As Desired
      Dim i As Long 'Common index variable
      Dim r As Long 'Row Counter for Index List
          r = TopRowOfList 'Set here because it's used to clear the list
       
      Application.ScreenUpdating = False

    ''''Clear the existing list
      If LastRow >= TopRowOfList Then ShtNdx.Range("A" & CStr(TopRowOfList) & _
                                          ":A" & CStr(LastRow)).ClearContents

    ''''Create the List of Sheet Names
      With ThisWorkbook
        For i = 1 To .Sheets.Count
          If .Sheets(i) Is ShtNdx Then
            'Don't list This sheet
            'Don't increment Row counter
            GoTo NextLoop
          Else
            ShtNdx.Cells(r, 1) = .Sheets(i).Name
            r = r + 1 'Increment Row Counter
          End If
NextLoop:
        Next i
      End With

    ''''Sort the list alphabetically
      Range("A4:A" & CStr(LastRow)).Sort _
        Key1:=Range("A1"), _
        Header:=xlNo
       
      Application.ScreenUpdating = True
    End Sub

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False

    ''''Check criteria for running this sub
        'Is only one Cell selected
      If Target.Count <> 1 Then Exit Sub
        'Is there a List
      If LastRow < 4 Then Exit Sub
        'Is the selection in the List
      If Intersect(Target, Range("A4:A" & CStr(LastRow))) Is Nothing Then Exit Sub
     
     
    ''''Move the Index Sheet, Activate the chosen Sheet, and Select "A1" _
        on the chosen Sheet.
      ShtNdx.Move Before:=Sheets(Target.Value)
      Sheets(Target.Value).Activate
      ActiveSheet.Range("A1").Select
     
    Application.ScreenUpdating = True
    End Sub
    
    Private Function LastRow() As Long
    'Custom for this module.
    'Always looks for the last non-empty cell in Column "A."
      LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    End Function
    
    Private Sub Workbook_SheetActivate(ByVal Sht As Object)
    'Moves the Sheet Index when any other tab is clicked.

      With Application
        .EnableEvents = False
        .ScreenUpdating = False
      End With
       
        ShtNdx.Move Before:=Sht
        Sht.Activate
     
        With Application
        .EnableEvents = True
        .ScreenUpdating = True
      End With

    End Sub