Automate Building A Table Of Contents For Your Spreadsheet With VBA

Creating a Spreadsheet with Table of Contents VBA code automate

Managing Large Workbooks

I've been working with a bunch of rather large Excel workbooks lately and it has come to the point where it is more efficient to navigate through a table of contents page rather than scrolling through the tabs themselves. One of my very first products after first launching this website back in 2014 was a template called the Tab Filter. I created this template to show how you could use VBA and some buttons to narrow down the visible tabs in a workbook.  For example, you could click on the 1995 button and only tabs with names containing "1995" would be left visible in the workbook.  This template is still available today and you can pick it up for free (or if you're feeling generous, you can make a donation payment along with download).

However, with my more recent situation, I'm pulling together a bunch of different reports that aren't really named in a nomenclature that can be narrowed down logically.  I found that a table of contents worksheet with hyperlinks directly to my tabs was much more efficient, but also a real pain to create.  Luckily, I know a thing or two about writing VBA code, so I whipped up a macro that could create a table of contents worksheet in seconds!

A VBA Macro To Automatically Insert A Table Of Contents Page

This code is very straightforward in its functionality.  It looks for a worksheet named "Contents" and if it already exists in the workbook, it asks to delete it.  Next, it inserts a new worksheet called "Contents" and gets to work creating hyperlinks to all the tabs in your Excel file.  Finally, I added a section that formats the Contents worksheet so it's pleasing to the eye (or at least to my eye).  You can stick this VBA code into your Personal Macros file and whip it out when your situation calls for it and create practical table of contents pages in seconds!

Here's the VBA Code

Sub TableOfContents_Create()
'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String

'Inputs
  ContentName = "Contents"

'Optimize Code
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False

'Delete Contents Sheet if it already exists
  On Error Resume Next
    Worksheets("Contents").Activate
  On Error GoTo 0

  If ActiveSheet.Name = ContentName Then
    myAnswer = MsgBox("A worksheet named [" & ContentName & _
      "] has already been created, would you like to replace it?", vbYesNo)
    
    'Did user select No or Cancel?
      If myAnswer <> vbYes Then GoTo ExitSub
      
    'Delete old Contents Tab
      Worksheets(ContentName).Delete
  End If

'Create New Contents Sheet
  Worksheets.Add Before:=Worksheets(1)

'Set variable to Contents Sheet
  Set Content_sht = ActiveSheet

'Format Contents Sheet
  With Content_sht
    .Name = ContentName
    .Range("B1") = "Table of Contents"
    .Range("B1").Font.Bold = True
  End With

'Create Array list with sheet names (excluding Contents)
  ReDim myArray(1 To Worksheets.Count - 1)

  For Each sht In ActiveWorkbook.Worksheets
    If sht.Name <> ContentName Then
      myArray(x + 1) = sht.Name
      x = x + 1
    End If
  Next sht
  
'Alphabetize Sheet Names in Array List
  For x = LBound(myArray) To UBound(myArray)
    For y = x To UBound(myArray)
      If UCase(myArray(y)) < UCase(myArray(x)) Then
        shtName1 = myArray(x)
        shtName2 = myArray(y)
        myArray(x) = shtName2
        myArray(y) = shtName1
      End If
     Next y
  Next x

'Create Table of Contents
  For x = LBound(myArray) To UBound(myArray)
    Set sht = Worksheets(myArray(x))
    sht.Activate
    With Content_sht
      .Hyperlinks.Add .Cells(x + 2, 3), "", _
      SubAddress:="'" & sht.Name & "'!A1", _
      TextToDisplay:=sht.Name
      .Cells(x + 2, 2).Value = x
    End With
  Next x
  
Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit

'A Splash of Guru Formatting! [Optional]
  Columns("A:B").ColumnWidth = 3.86
  Range("B1").Font.Size = 18
  Range("B1:F1").Borders(xlEdgeBottom).Weight = xlThin
  
  With Range("B3:B" & x + 1)
    .Borders(xlInsideHorizontal).Color = RGB(255, 255, 255)
    .Borders(xlInsideHorizontal).Weight = xlMedium
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Color = RGB(255, 255, 255)
    .Interior.Color = RGB(91, 155, 213)
  End With

  'Adjust Zoom and Remove Gridlines
    ActiveWindow.DisplayGridlines = False
    ActiveWindow.Zoom = 130

ExitSub:
'Optimize Code
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
End Sub

Limiting The Lines Per Column

In the event you have an extremely large amount of tabs in your Excel workbook, you may want multiple columns of hyperlinks.  To handle these situations, I tweaked the code a little bit to let the user decide how many columns to have in the Table of Contents.  Take a look at how I can now fit the 50 states easily in a much more condensed format.

Here's The VBA Code

Sub TableOfContents_Create()
'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab (multiple columns)
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long, z As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String
Dim shtCount As Long
Dim ColumnCount As Variant

'Inputs
  ContentName = "Contents"

'Optimize Code
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False

'Delete Contents Sheet if it already exists
  On Error Resume Next
    Worksheets("Contents").Activate
  On Error GoTo 0

  If ActiveSheet.Name = ContentName Then
    myAnswer = MsgBox("A worksheet named [" & ContentName & _
      "] has already been created, would you like to replace it?", vbYesNo)
    
    'Did user select No or Cancel?
      If myAnswer <> vbYes Then GoTo ExitSub
      
    'Delete old Contents Tab
      Worksheets(ContentName).Delete
  End If

'Count how many Visible sheets there are
  For Each sht In ActiveWorkbook.Worksheets
    If sht.Visible = True Then shtCount = shtCount + 1
  Next sht

'Ask how many columns to have
  ColumnCount = Application.InputBox("You have " & shtCount & _
    " visible worksheets." & vbNewLine & "How many columns " & _
    "would you like to have in your Contents tab?", Type:=2)

'Check if user cancelled
  If TypeName(ColumnCount) = "Boolean" Or ColumnCount < 0 Then GoTo ExitSub

'Create New Contents Sheet
  Worksheets.Add Before:=Worksheets(1)

'Set variable to Contents Sheet and Rename
  Set Content_sht = ActiveSheet
  Content_sht.Name = ContentName
  
'Create Array list with sheet names (excluding Contents)
  ReDim myArray(1 To shtCount)

  For Each sht In ActiveWorkbook.Worksheets
    If sht.Name <> ContentName And sht.Visible = True Then
      myArray(x + 1) = sht.Name
      x = x + 1
    End If
  Next sht
  
'Alphabetize Sheet Names in Array List
  For x = LBound(myArray) To UBound(myArray)
    For y = x To UBound(myArray)
      If UCase(myArray(y)) < UCase(myArray(x)) Then
        shtName1 = myArray(x)
        shtName2 = myArray(y)
        myArray(x) = shtName2
        myArray(y) = shtName1
      End If
     Next y
  Next x

'Create Table of Contents
  x = 1

  For y = 1 To ColumnCount
    For z = 1 To WorksheetFunction.RoundUp(shtCount / ColumnCount, 0)
      If x <= UBound(myArray) Then
        Set sht = Worksheets(myArray(x))
        sht.Activate
        With Content_sht
          .Hyperlinks.Add .Cells(z + 2, 2 * y), "", _
          SubAddress:="'" & sht.Name & "'!A1", _
          TextToDisplay:=sht.Name
        End With
        x = x + 1
      End If
    Next z
  Next y

'Select Content Sheet and clean up a little bit
  Content_sht.Activate
  Content_sht.UsedRange.EntireColumn.AutoFit
  ActiveWindow.DisplayGridlines = False

'Format Contents Sheet Title
  With Content_sht.Range("B1")
    .Value = "Table of Contents"
    .Font.Bold = True
    .Font.Size = 18
  End With

ExitSub:
'Optimize Code
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
End Sub

Adding Hyperlinks Back To Your Table of Contents

If you want to have a way to easily navigate back to your Contents tab, you may want to add this snippet of VBA code to your Table of Contents macro. This code will add a button near cell A1 of every worksheet with a hyperlink back to your contents page. I decided to use a button that sits on top of the spreadsheet instead of using an in-cell hyperlink to bypass the chance of overriding any data that might be sitting in cell A1. You can run this as a separate macro or copy & paste it (do NOT include the "Sub" statements) into either of the above routines to carry out a "one and done" execution.

This VBA macro is also written in a way that if you need to refresh your table of contents (ie rerun the table of contents macro), it will delete any buttons that may have been created in the past. Essentially this prevents your spreadsheets from having piles of buttons pointing to your table of contents sheet after multiple refreshes of your contents tab.

I want to give a special thanks to Jim F. (via email) for suggesting this feature. Great idea!

Sub Contents_Hyperlinks()
'PURPOSE: Add hyperlinked buttons back to Table of Contents worksheet tab
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim shp As Shape
Dim ContentName As String
Dim ButtonID As String

'Inputs:
  ContentName = "Contents" 'Table of Contents Worksheet Name
  ButtonID = "_ContentButton" 'ID to Track Buttons for deletion
  
'Loop Through Each Worksheet in Workbook
  For Each sht In ActiveWorkbook.Worksheets
  
    If sht.Name <> ContentName Then
      
      'Delete Old Button (if necessary when refreshing)
        For Each shp In sht.Shapes
          If Right(shp.Name, Len(ButtonID)) = ButtonID Then
            shp.Delete
            Exit For
          End If
        Next shp
        
      'Create & Position Shape
        Set shp = sht.Shapes.AddShape(msoShapeRoundedRectangle, _
          4, 4, 60, 20)

      'Format Shape
        shp.Fill.ForeColor.RGB = RGB(91, 155, 213) 'Blue
        shp.Line.Visible = msoFalse
        shp.TextFrame2.TextRange.Font.Size = 10
        shp.TextFrame2.TextRange.Text = ContentName
        shp.TextFrame2.TextRange.Font.Bold = True
        shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255) 'White
      
      'Track Shape Name with ID Tag
        shp.Name = shp.Name & ButtonID
      
      'Assign Hyperlink to Shape
        sht.Hyperlinks.Add shp, "", _
          SubAddress:="'" & ContentName & "'!A1"
  
    End If
    
  Next sht

End Sub

Learn More With This Example Workbook

I have created a sample workbook with 4 different variations of VBA code for creating table of contents for your Excel workbook. The workbook and its code are completely unlocked so you can dig in and discover how the magic works. As always, in order to download this example file you will need to be a subscriber of my free newsletter.  If you click the green button below you can easily sign up and you will be emailed the password to get into the subscribers-only area of this website.

 
     Already Subscribed? Click HERE to log-in to the "Example Files" section

     Already Subscribed? Click HERE to log-in to the "Example Files" section

 

Workbook Navigation Made Easier

Hopefully, after running one of the two macros I created in this article you are able to navigate your workbook much more efficiently. I'm curious if there would be other features or formatting techniques that you would recommend to improve this code.  Leave your thoughts in the comments section below as I'd love to hear from you and pick your brain a little bit.

How Do I Modify This To Fit My Specific Needs?

Chances are this post did not give you the exact answer you were looking for. We all have different situations and it's impossible to account for every particular need one might have. That's why I want to share with you: My Guide to Getting the Solution to your Problems FAST! In this article, I explain the best strategies I have come up with over the years to getting quick answers to complex problems in Excel, PowerPoint, VBA, you name it

I highly recommend that you check this guide out before asking me or anyone else in the comments section to solve your specific problem. I can guarantee 9 times out of 10, one of my strategies will get you the answer(s) you are needing faster than it will take me to get back to you with a possible solution. I try my best to help everyone out, but sometimes I don't have time to fit everyone's questions in (there never seem to be quite enough hours in the day!).

I wish you the best of luck and I hope this tutorial gets you heading in the right direction!

Chris "Macro" Newman :)