Create Index of Worksheets

[Hydestone]

This code works but seems slow. Anyone got a cleaner way to do this?

- Index Worksheet starts off blank.
- When a new worksheet is added, the name of the new worksheet automatically appears on the Index worksheet in alphabetical order.
- When a new worksheet is added, a link is automatically added to the top of the new worksheet which directs back to the Index.
- The worksheet names on the Index tab are all hyperlinks which open the worksheets.

Here is the code I've been using.

Sub AutoTOC()
End Sub
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim n As Integer
Dim calcState As Long, scrUpdateState As Long


calcState = Application.Calculation
Application.Calculation = xlCalculationManual
scrUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False
n = 1


With Me
.Columns(1).ClearContents
.Cells(1, 1) = "Worksheet Index"
.Cells(1, 1).Name = "Index"
End With

For Each wSheet In Worksheets
If wSheet.Name <> Me.Name Then
n = n + 1
With wSheet
.Range("A1").Name = "Start_" & wSheet.Index 'Change range to suit here and in next line
.Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With

Me.Hyperlinks.Add Anchor:=Me.Cells(n, 1), Address:="", _
SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
With Me.Range("A1")
.Font.Bold = True
.Font.Size = 14
End With
lRw = Range("A" & Rows.Count).End(xlUp).Row
With Me.Range("A2", "A" & lRw).Font
.Bold = True
.Underline = False
.Size = 12
End With


Range("A2:A80").Select
ActiveWorkbook.Worksheets("Index").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Index").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Index").Sort
.SetRange Range("A2:A27")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply

End With


Range("A1").Select

Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState


End Sub

 

[BrianJN1]

Do you really need a macro for your index?

It is possible to view all of your Worksheet names by going to the lower left corner to the worksheet scroll arrows and right-click. It brings up a dialog from which you may select a specific sheet and go to it.

 

[Hydestone]

Not absolutely necessary, but convenient when there is a long list of sheets, some of which are hidden.