Make automatic Excel worksheet list or table of contents

Office for Mere Mortals helps people around the world get more from Word, Excel, PowerPoint and Outlook. Delivered once a week. free.


Continuing our look at Excel tab/worksheet listing here’s a fully automated alternative with more control and filtering.

See Make Excel tabs list in a worksheet
Automatic worksheet/tabs list in Excel 
Fit more tabs across an Excel workbook

There are many VBA code samples on the Internet, we’ve taken one we like and added some extras based on questions from readers.

Here’s the Table of Contents at work.  Each tab has a clickable link, the worksheet type and visibility.

Advantages

It’s compatible across all Excel releases.

The VBA code only works on Excel for Windows or Mac. Any changes to the tabs will only be updated when the workbook is opened in Excel Windows or Mac.

However, the Table of Contents works in Excel Online, Excel for Android and Excel for Apple devices.

The complete tabs list

The full VBA code is at the bottom of this article.  ‘BrettDJ’ posted the code at StackOverflow and did a very nice job. It has error checking, a warning when the current TOC is being replaced and is well documented.

We’ve added a column showing the tab visibility to help understand one of the tweaks we’ve included.

The important part of the code, which creates the list looks like this:

' Add tab name with link in Col A
ws.Hyperlinks.Add Anchor:=ws.Cells(lngTOCRow, 1), Address:="", SubAddress:="'" & ActiveWorkbook.Sheets(lngSht).Name & "'!A1", TextToDisplay:=ActiveWorkbook.Sheets(lngSht).Name
' Adds the type of tab (Worksheet etc) to col B
ws.Cells(lngTOCRow, 2).Value = TypeName(ActiveWorkbook.Sheets(lngSht))
' Adds the tab visibility (Worksheet etc) to col C
ws.Cells(lngTOCRow, 3).Value = sSheetVisibility

List Visible Worksheets only

It’s quite likely you’ll only want a list of visible tabs.  Do that by wrapping the above lines with an IF statement to test for visibility.

'Add hyperlinks to visible only worksheets
If ActiveWorkbook.Sheets(lngSht).Visible = xlSheetVisible Then
' SAME CODE AS ABOVE
End If

Omit certain worksheets

Some readers asked about making a more select or curated list of tabs.  With some visible tabs dropped from the clickable list.

We’ve added a test for the tilde ~ in tab name.  If present, that tab isn’t added to the index list.

'Add hyperlinks to worksheets that do NOT have a tilde in tab name
' If InStr(ActiveWorkbook.Sheets(lngSht).Name, "~") = 0 Then
            ' SAME CODE AS ABOVE
End If

Or reverse it to only show tabs with tilde in the list.

'Add hyperlinks to worksheets that have a tilde in tab name
' If InStr(ActiveWorkbook.Sheets(lngSht).Name, "~") > 0 Then
            ' SAME CODE AS ABOVE
End If

Replace the tilde with any character or word you like.

Update the list automatically

If you’d like the table of contents to update automatically, a few changes are necessary:

  1. Add ‘Application.Volatile’ immediately below the SUB CreateTOC() line. This tells Excel to run the function whenever it’s recalculating the worksheet.
  2. Change the line:

lngProceed = MsgBox("Index exists!" & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbCritical, "Warning")

to

lngProceed = vbYes

That will prevent the overwrite question from appearing with an automatic ‘Yes’ instead.

  1. Somewhere in the worksheet, add the function CreateTOC() so Excel will recalculate it.

Other tweaks

Make more room for visible links by removing the header text with the workbook name, update time and number of worksheets.

  1. Comment out the section starting with ” ‘Add headers and formatting  “
  2. Change the TOC list starting row value to a lower number

Dim lngTOCRow As Long: lngTOCRow = 6    ' starting row for TOC

 

The VBA Code

 

Option Explicit

 

Sub CreateTOC()

' from brettdj at

' https://stackoverflow.com/questions/14358443/vba-list-of-sheets-hyperlinked

' slightly adapted by Office-Watch.com

   

    Dim ws As Worksheet

    Dim nmToc As Name

    Dim rng1 As Range

    Dim lngProceed As Boolean

    Dim bNonWkSht As Boolean

    Dim lngSht As Long

    Dim lngShtNum As Long

    Dim strWScode As String

    Dim vbCodeMod

 

    'Test for an ActiveWorkbook to summarise

    If ActiveWorkbook Is Nothing Then

        MsgBox "You must have a workbook open first!", vbInformation, "No Open Book"

        Exit Sub

    End If

 

    'Turn off updates, alerts and events

    With Application

        .ScreenUpdating = False

        .DisplayAlerts = False

        .EnableEvents = False

    End With

 

    'If the Table of Contents exists (using a marker range name "TOC_Index") prompt the user whether to proceed

    On Error Resume Next

    Set nmToc = ActiveWorkbook.Names("TOC_Index")

    If Not nmToc Is Nothing Then

        lngProceed = MsgBox("Index exists!" & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbCritical, "Warning")

        If lngProceed = vbYes Then

            Exit Sub

        Else

            ActiveWorkbook.Sheets(Range("TOC_Index").Parent.Name).Delete

        End If

    End If

    Set ws = ActiveWorkbook.Sheets.Add

    ws.Move before:=Sheets(1)

   

    'Add the marker range name

    ActiveWorkbook.Names.Add "TOC_INDEX", ws.[a1]

    ws.Name = "TOC_Index"

    On Error GoTo 0

 

    On Error GoTo ErrHandler

   

    Dim lngTOCRow As Long: lngTOCRow = 6    ' starting row for TOC

    Dim sSheetVisibility: sSheetVisibility = ""    ' text for sheet visibility status

 

    For lngSht = 2 To ActiveWorkbook.Sheets.Count

        'set to start at A6 of TOC sheet

        'Test sheets to determine whether they are normal worksheets

       

       Select Case ActiveWorkbook.Sheets(lngSht).Visible

        ' make text labels for each tab visibility property.

         Case -1  ' Visible

           sSheetVisibility = "Visible"

         Case 0 ' Hidden

             sSheetVisibility = "Hidden"

         Case 1 ' Very Hidden

            sSheetVisibility = "Very Hidden"

        End Select

               

        If TypeName(ActiveWorkbook.Sheets(lngSht)) = "Worksheet" Then

                  

            ' Add tab name with link in Col A

              ws.Hyperlinks.Add Anchor:=ws.Cells(lngTOCRow, 1), Address:="", SubAddress:="'" & ActiveWorkbook.Sheets(lngSht).Name & "'!A1", TextToDisplay:=ActiveWorkbook.Sheets(lngSht).Name

            ' Adds the type of tab (Worksheet etc) to col B

                ws.Cells(lngTOCRow, 2).Value = TypeName(ActiveWorkbook.Sheets(lngSht))

            ' Adds the tab visibility (Worksheet etc) to col C

                ws.Cells(lngTOCRow, 3).Value = sSheetVisibility

           

            ' this is in ALL code to add another row

               lngTOCRow = lngTOCRow + 1

            ' End If

                      

        Else

            'Add name of any non-worksheets

            ws.Cells(lngTOCRow, 1).Value = ActiveWorkbook.Sheets(lngSht).Name

            'Colour these sheets yellow

            ws.Cells(lngTOCRow, 1).Interior.Color = vbYellow

            ws.Cells(lngTOCRow, 2).Font.Italic = True

            bNonWkSht = True

           

            ' another row

            lngTOCRow = lngTOCRow + 1

        End If

 

    Next lngSht

 

    'Add headers and formatting

    With ws

        With .[a1:a4]

            .Value = Application.Transpose(Array(ActiveWorkbook.Name, "", Format(Now(), "dd-mmm-yy hh:mm"), ActiveWorkbook.Sheets.Count - 1 & " sheets - all"))

            .Font.Size = 14

            .Cells(1).Font.Bold = True

        End With

        With .[a6].Resize(lngSht - 1, 1)

            .Font.Bold = True

            .Font.ColorIndex = 41

            .Resize(1, 2).EntireColumn.HorizontalAlignment = xlLeft

            .Columns("A:B").EntireColumn.AutoFit

        End With

    End With

 

    'Add warnings and macro code if there are non WorkSheet types present

    If bNonWkSht Then

        With ws.[A5]

            .Value = "This workbook contains at least one Chart or Dialog Sheet. These sheets will only be activated if macros are enabled (NB: Please doubleclick yellow sheet names to select them)"

            .Font.ColorIndex = 3

            .Font.Italic = True

        End With

        strWScode = "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" & vbCrLf _

                    & "     Dim rng1 As Range" & vbCrLf _

                    & "     Set rng1 = Intersect(Target, Range([a6], Cells(Rows.Count, 1).End(xlUp)))" & vbCrLf _

                    & "     If rng1 Is Nothing Then Exit Sub" & vbCrLf _

                    & "     On Error Resume Next" & vbCrLf _

                    & "     If Target.Cells(1).Offset(0, 1) <> ""Worksheet"" Then Sheets(Target.Value).Activate" & vbCrLf _

                    & "     If Err.Number <> 0 Then MsgBox ""Could not select sheet"" & Target.Value" & vbCrLf _

                    & "End Sub" & vbCrLf

 

        Set vbCodeMod = ActiveWorkbook.VBProject.VBComponents(ws.CodeName)

        vbCodeMod.CodeModule.AddFromString strWScode

    End If

 

    'tidy up Application settins

    With Application

        .ScreenUpdating = True

        .DisplayAlerts = True

        .EnableEvents = True

    End With

 

ErrHandler:

    If Err.Number <> 0 Then MsgBox Err.Description & vbCrLf & "Please note that your Application settings have been reset", vbCritical, "Code Error!"

End Sub


Want More?

Office Watch has the latest news and tips about Microsoft Office. Independent since 1996. Delivered once a week.