Alphabetize worksheet list

0

I have a list of worksheets from this code

Sub WorkSheetListD()

    Dim ws As Worksheet

    Dim Counter As Integer

    Counter = 0

    For Each ws In ActiveWorkbook.Worksheets

       If Left(ws.Name, 3) = Worksheets("general.switchboard").Range("AQ53") Then

            Sheets("general.switchboard").Range("AJ58").Offset(Counter, 0).Value = ws.Name

            Sheets("general.switchboard").Range("AV58").Offset(Counter, 0).Value = ws.Index

            Sheets("general.switchboard").Range("AS58").Offset(Counter, 0).Value = ws.CodeName

            Counter = Counter + 1

        End If

    Next ws

End Sub

I would like to have this list come out alphabetically by ws.name

Answer
Discuss

Answers

0
Selected Answer

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
Discuss

Discussion

THANKS I couldn't get it to work but that's ok i got a work-around made this morning  nvolving a macro
KDS1489 (rep: 6) Nov 2, '19 at 8:33 am
I had problems with the macro (my own stupidity) and tried your code again. This time it worked. Problem was the way I paste it.
Thank again
KDS1489 (rep: 6) Nov 2, '19 at 11:04 am
I’m going to you because I have been using your code But in just the past day I get a debug that points to 
 Set Ws = ThisWorkbook.Worksheets(.Cells(R).Value)
Because of comment length limits I didn’t copy/post original code. I’m new too VBA so can you help me or point me in the right direction?
KDS1489 (rep: 6) Nov 22, '19 at 8:37 am
I tested the code before publishing it. You tested the code and found it working. Therefore we can be sure that the reson for the failure now isn't in the code. It must be in something that you changed since it last worked. The error message you get from the debugger will give you a hint. Check the constants at the top of the code. A possible cause of the problem is that cell #R of the range Rng doesn't contain a valid sheet name. To check further, run the code until it crashes, press 'Debug' and then type in the Immediate Window
? Rng.Cells(R).Address, Rng.Cells(R).Value
Press Return to print the address of the offending cell and the cell's value. If that doesn't help, ask a new question and attach the workbook with the code in it.
Variatus (rep: 3243) Nov 22, '19 at 8:29 pm
I found problem. I went to a saved copy from the day before and started from there. My problem started when I renamed the module it was in. I don’t know why that would matter, maybe there’s another problem I never found, but I saved that to a new file and started using it with the module name unchanged, but at least now it works. Thanks for understanding and the help.
Happy holidays.
KDS1489 (rep: 6) Nov 23, '19 at 7:10 am
You are right. Changing the code module's name can't produce the error you described. Just be sure that it is a standard code module, one whose name was like Module1 before you renamed it, not one of the built-in code modules Excel creates.
I notice that my procedure is declared as Private. If you wish to call the procedure from a button, or by some other way from the UI, it should be Public. If you remove the word Private from the declaration it will become Public by default.
Variatus (rep: 3243) Nov 24, '19 at 5:12 am
Add to Discussion
0

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.

Discuss

Discussion

Hello KDS,
I'm glad you got my code to work for you.
As for your new question, please post it as a new question. Here it is presented as an "Answer" to your original question. Forum users will find this confusing. Once it appears as a new question other experts will also get a change to look at it.
Note that you can only post Excel workbooks on this forum. There is no way to upload screenshots.
Variatus (rep: 3243) Nov 2, '19 at 10:28 pm
THANKS 
Iwill
KDS1489 (rep: 6) Nov 3, '19 at 7:05 am
Add to Discussion
0

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

Discuss


Answer the Question

You must create an account to use the forum. Create an Account or Login