TOC sorted alphabetically

[Victtor]

I have code to create a Table of Contents based on worksheets. Can someone please add code to have this list sorted alphabetically? Thanks in advance

Sub tocmaker()
Dim wsh As Worksheet
Dim cnt As Long
Dim doit As String
If Application.CountA(ActiveSheet.Range("A:A")) > 0 Then
doit = MsgBox("There is already text in column A of " & ActiveSheet.Name & " where the TOC will be made. This will overwrite data in column A. Do it anyway?", vbYesNo, "ALERT")
If doit <> vbYes Then
Exit Sub
End If
End If
'make toc
ActiveSheet.Range("A1") = "TABLE OF CONTENTS:"
cnt = 2
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Visible = True And wsh.Name <> ActiveSheet.Name Then
ActiveSheet.Cells(cnt, 1) = wsh.Name
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(cnt, 1), Address:="", SubAddress:="'" & wsh.Name & "'!A1", TextToDisplay:=wsh.Name
cnt = cnt + 1
End If
Next
MsgBox "Table of Contents created on " & ActiveSheet.Name & vbCr & "Use MAIN MENU creator to make a return link to main menu."
End Sub

 

[Fluff]

Just add this to the end of your code

    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveSheet.Sort
        .SetRange Range("A1", Range("A" & Rows.Count).End(xlUp))
        .Header = xlYes
        .MatchCase = True
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

 

[Victtor]

Thanks, worked like a charm. I

 

[Fluff]

Glad to help & thanks for the feedback