I find myself often using a number of worksheets in a workbook and navigating through them is cumbersome. Googling for help, I found a a post on the office blogs where a simple macro would automagically create a table of contents (TOC) of all worksheets with hyperlink shortcuts.
I’ve slightly improved the version, the result:
- the macro still creates a TOC 😉
- you can add worksheets, run the macro again and it will preserve whatever you have in column B (e.g. a description)
- you can quickly jump back to your TOC with
CTRL-G gg
. The macro adds a shortcut to the TOC sheet, by naming cell A1 “gg”.
Caveat: if you change the order of the tabs and run the macro again, you’ll have to change the order of column B manually.
No idea, how to use this code? Check out, how to add VBA code to your computer.
Sub swaCreateTOC() Dim wbBook As Workbook Dim wsActive As Worksheet Dim wsSheet As Worksheet Dim lnRow As Long Dim lnPages As Long Dim lnCount As Long Dim DataRange As Variant Dim Irow As Long Dim Icol As Integer Dim MyVar As Double Set wbBook = ActiveWorkbook With Application .DisplayAlerts = False .ScreenUpdating = False End With 'If the TOC sheet already exist delete it and add a new 'worksheet. On Error Resume Next With wbBook DataRange = .Worksheets("TOC").Range("B1:B10000").Value ' read all the values at once from the Excel grid, put into an array .Worksheets("TOC").Delete .Worksheets.Add Before:=.Worksheets(1) End With On Error GoTo 0 Set wsActive = wbBook.ActiveSheet With wsActive .Name = "TOC" With .Range("A1:B1") .Value = VBA.Array("Worksheet", "Content") .Font.Bold = True End With End With If Not IsEmpty(DataRange) Then wsActive.Range("B1:B10000").Value = DataRange ' writes all the results back to the range at once End If lnRow = 2 lnCount = 1 'Iterate through the worksheets in the workbook and create 'sheetnames, add hyperlink and count & write the running number 'of pages to be printed for each sheet on the TOC sheet. For Each wsSheet In wbBook.Worksheets If wsSheet.Name <> wsActive.Name Then wsSheet.Activate With wsActive .Hyperlinks.Add .Cells(lnRow, 1), "", _ SubAddress:="'" & wsSheet.Name & "'!A1", _ TextToDisplay:=wsSheet.Name lnPages = wsSheet.PageSetup.Pages().Count End With lnRow = lnRow + 1 lnCount = lnCount + 1 End If Next wsSheet wsActive.Activate wsActive.columns("A:B").EntireColumn.AutoFit ActiveWindow.DisplayGridlines = False ' now add the name "gg" to A1 of "TOC", so you can jump to it with CTRL-G gg wbBook.Names.Add "gg", RefersTo:=Sheets("TOC").Range("A1") With Application .DisplayAlerts = True .ScreenUpdating = True End With Ende: End Sub