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:
- Add ‘Application.Volatile’ immediately below the SUB CreateTOC() line. This tells Excel to run the function whenever it’s recalculating the worksheet.
- 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.
- 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.
- Comment out the section starting with ” ‘Add headers and formatting “
- 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
