Index Excel Sheets with Hyperlink Automatically

Index Sheets with Hyperlink Auto

(Excel VBA)

1. Hold down the ALT + F11 keys to open the Microsoft Visual Basic for Applications window.

2. Click Insert > Module, and paste the following code in the Module Window.

3. Then press F5 key to run this code

 


 Sub Index_Sheets_link()
 ' Index all sheets with Hyperlink

If ActiveWorkbook Is Nothing Then
 MsgBox "You must have a workbook open first!", vbInformation, "No Open Book"
 Exit Sub
 End If

With Application
 .ScreenUpdating = False
 .DisplayAlerts = False

Dim WS As Worksheet, _
 ct As Chart, _
 shtName As String, _
 nrow As Long, _
 tmpCount As Long, _
 i As Long, _
 numCharts As Long

nrow = 3
 i = 1
 numCharts = ActiveWorkbook.Charts.Count

On Error GoTo hasSheet
 Sheets("Index of Sheets").Activate
 If MsgBox("You already have a Index of Sheets. Would you like to overwrite it?", _
 vbYesNo + vbQuestion, "Replace TOC page?") = vbYes Then GoTo createNew
 Exit Sub

hasSheet:
 Sheets.Add before:=Sheets(1)
 GoTo hasNew

createNew:
 Sheets("Index of Sheets").Delete
 GoTo hasSheet

hasNew:
 tmpCount = ActiveWorkbook.Charts.Count
 If tmpCount > 0 Then tmpCount = 1
 ActiveSheet.Name = "Index of Sheets"

With Sheets("Index of Sheets")
 '.Cells.Interior.ColorIndex = 4
 With .Range("B2")
 .Value = "Index of Sheets"
 .Font.Bold = True
 .Font.Name = "Calibri"
 .Font.Size = "24"
 End With
 End With

For Each WS In ActiveWorkbook.Worksheets
 nrow = nrow + 1
 With WS
 shtName = WS.Name
 With Sheets("Index of Sheets")
 .Range("B" & nrow).Value = nrow - 3
 .Range("C" & nrow).Hyperlinks.Add _
 Anchor:=Sheets("Index of Sheets").Range("C" & nrow), Address:="#'" & _
 shtName & "'!A1", TextToDisplay:=shtName
 .Range("C" & nrow).HorizontalAlignment = xlLeft
 End With
 End With
 Next WS

If numCharts <> 0 Then
 For Each ct In ActiveWorkbook.Charts
 nrow = nrow + 1
 shtName = ct.Name
 With Sheets("Index of Sheets")
 .Range("B" & nrow).Value = nrow - 3
 .Range("C" & nrow).Value = shtName
 .Range("C" & nrow).HorizontalAlignment = xlLeft
 End With
 Next ct
 End If

With Sheets("Index of Sheets")
 With .Range("B2:G2")
 .MergeCells = True
 .HorizontalAlignment = xlLeft
 End With

With .Range("C:C")
 .EntireColumn.AutoFit
 .Activate
 End With
 .Range("B4").Select
 End With

.DisplayAlerts = True
 .ScreenUpdating = True
 End With

MsgBox "Done!" & vbNewLine & vbNewLine & "Please note: " & _
 "Charts are listed after regular " & vbCrLf & _
 "worksheets and will not have hyperlinks.", vbInformation, "Complete!"

End Sub

 

Share this post

Post Comment

3 × 2 =