Create a Table Of Contents With Hyperlinks In Excel Using VBA

Want to generate a Table of Contents or an Index as some may call it in your Excel workbook?

It isn't as tough as it may seem at first.

Put the below code in a standard code module and then execute. The code will generate a new sheet called Index, and generate an Index or a Table Of Contents with working Hyperlinks to all the worksheets.

-------------------------------------------------------------------------------------

Sub HyperlinkWorksheetNames()

'Code by Deep Dave, makes a Table of Content on a new sheet named Index 'Check out some helpful Excel blogs on www.NeedForExcel.com

Dim R() As Variant, WS As Worksheet, i As Byte, Counter As Integer, LR As Integer On Error Resume Next 'If the Worksheet named Index does not exist, this will ignore the generated error

Application.DisplayAlerts = False 'Display alerts when set to false, will not ask confirmation Sheets("Index").Delete Application.DisplayAlerts = True On Error GoTo 0 Worksheets.Add Worksheets(1) 'To add a new Worksheet to have an Index or TOC ActiveSheet.Name = "Index" 'Rename the newly added sheet to Index For Each WS In ThisWorkbook.Worksheets 'Loop runs through all the Worksheets and stores worksheet names in Array named R i = i + 1 'Increments by 1, which we can use a subscript of the array ReDim Preserve R(i - 1) 'The Array named R stores sheet names one by one R(i - 1) = WS.Name Next WS Range("A1").Resize(UBound(R) + 1, 1).Value = Application.Transpose(R) 'Spits out the array vertically on Range A1 of sheet Index Set WS = ActiveSheet 'Object Variable WS is set to refer to the Activesheet LR = Cells(Rows.Count, 1).End(xlUp).Row 'Finds out the last used row For Counter = 2 To LR 'Runs a loop, based on the name adds a hyperlink to the respective sheet With WS 'Adds a Hyperlink to each cell based on cell value. 'Also notice "'" concatenated at both ends, this is done to accomodate sheet names with spaces in between. .Hyperlinks.Add Anchor:=.Cells(Counter, 1), Address:="", SubAddress:="'" & Cells(Counter, 1).Value2 & "'" & "!A1" End With Next Counter Erase R() 'Erases the Array named R End Sub

-------------------------------------------------------------------------------------

#Index #tableofcontentexcel #excelprogramming #exceltricks #DatabaseConnectivityUsingVBA #excel2016 #excelcoding

Follow Us
  • Twitter Basic Square
  • Google+ Basic Square
Recent Posts