Create Or Update A Hyperlink Index Of Visible Sheets

[MrBlackd]

Place the code below in a standard module and run Indexing Sub so as to create or update a hyperlink index of all visible sheets in a new sheet called INDEX.
Also a "Back to index" will be added to the top of each visible sheet by inserting rows so to avoid deleting existing data.

enjoy

Dim wSheet As Worksheet, mySht As Worksheet
Dim l As Long

Sub Indexing()

RESPONSE = MsgBox("Select 'Yes' to create an index or 'No' to refresh the existing one. Select 'Cancel' to abort.", vbYesNoCancel)

If RESPONSE = vbYes Then
Call Generate_Index
MsgBox "Index created"
ElseIf RESPONSE = vbNo Then
Call Refresh_Index
MsgBox "Index updated"
Else
MsgBox "Operation cancelled"
End If

End Sub


Sub Refresh_Index()
    
With Application
    .ScreenUpdating = False
    .Cursor = xlWait
End With
    
    l = 1
    Set mySht = Sheets("INDEX")
    With mySht
        .Columns(1).ClearContents
        .Cells(1, 1) = "INDEX"
        .Cells(1, 1).name = "Index"
        .Cells(1, 1).font.Bold = True
        .Cells(1, 1).Interior.Color = 12859158
        .Cells(1, 1).font.ThemeColor = xlThemeColorDark1
    End With


    For Each wSheet In Worksheets

        If wSheet.Visible = True And wSheet.name <> "INDEX" And wSheet.Range("A1").Text = "Back to Index" Then
                   
            l = l + 1
                With wSheet
                    .Range("A1").name = "Start_" & wSheet.INDEX
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                    .Range("A1").EntireColumn.AutoFit
                End With
                mySht.Hyperlinks.Add Anchor:=mySht.Cells(l, 1), Address:="", _
                SubAddress:="Start_" & wSheet.INDEX, TextToDisplay:=wSheet.name
                
        ElseIf wSheet.Visible = True And wSheet.name <> "INDEX" Then
                
                wSheet.Select
                Rows("1:1").Select
                For i = 1 To 2
                Selection.Insert Shift:=xlDown
                Next i
                Range("A1").Select
                
             l = l + 1
                With wSheet
                    .Range("A1").name = "Start_" & wSheet.INDEX
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                    .Range("A1").EntireColumn.AutoFit
                End With
                mySht.Hyperlinks.Add Anchor:=mySht.Cells(l, 1), Address:="", _
                SubAddress:="Start_" & wSheet.INDEX, TextToDisplay:=wSheet.name
               
                
        End If
    Next wSheet
    
    mySht.Select

With Application
    .ScreenUpdating = True
    .Cursor = xlDefault
End With

End Sub

Sub Generate_Index()

With Application
    .ScreenUpdating = False
    .Cursor = xlWait
End With

    l = 1
    Worksheets.Add(Before:=Worksheets(1)).name = "INDEX"
    Set mySht = Sheets("INDEX")
    With mySht
        .Columns(1).ClearContents
        .Cells(1, 1) = "INDEX"
        .Cells(1, 1).name = "Index"
        .Cells(1, 1).font.Bold = True
        .Cells(1, 1).Interior.Color = 12859158
        .Cells(1, 1).font.ThemeColor = xlThemeColorDark1
    End With

    For Each wSheet In Worksheets

        If wSheet.Visible = True And wSheet.name <> "INDEX" Then
                wSheet.Select
                Rows("1:1").Select
                For i = 1 To 2
                Selection.Insert Shift:=xlDown
                Next i
                Range("A1").Select
                
            l = l + 1
                With wSheet
                    .Range("A1").name = "Start_" & wSheet.INDEX
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                    .Range("A1").EntireColumn.AutoFit
                End With
                mySht.Hyperlinks.Add Anchor:=mySht.Cells(l, 1), Address:="", _
                SubAddress:="Start_" & wSheet.INDEX, TextToDisplay:=wSheet.name
        End If
    Next wSheet
    
    mySht.Select
    
With Application
    .ScreenUpdating = True
    .Cursor = xlDefault
End With
End Sub

[Admin]

Thanks for sharing Keep posting