Excel VBA to create a Table of Contents (TOC) summary sheet: table of contents, index, hyperlink

Introduction

This Article provides VBA code that will create a Table of Contents (TOC) summary sheet for all Sheets in the Active Workbook.

A TOC sheet provides a useful index for larger files, especially when they are shared between many users. I suggest that every Workbook should be saved with such a TOC active, and with the active cell set to A1 on all Worksheets — good practice to help avoid potential confusion and errors. It is highly recommended that having run this code that users (manually) add further descriptive text, colour coding, model maps etc to the TOC to designate sheet functionality (assumption sheets, input sheets, scenarios, outputs etc).

While most readers will look at this Article in order to use this code, coders may find the programmatic insertion of a Sheet event useful for other tasks.

TOC Outputs

The code produces a brief summary of the Workbook Name, the time the TOC was created, and the total number of Sheets in the TOC report.

TOC.png

14 KB
TOC Output Summary

Each individual sheet name is listed below the summary, these names act as a live index to the Sheets in the Workbook.

Two methods are used to create the links to the Active Workbook Sheets:

1) Simple hyperlinks are created for standard Worksheets.
2) Less commonly used Chart Sheets — and even rarer Dialog Sheets — cannot be hyperlinked. If this code detects a non-Worksheet type, a Sheet BeforeDoubleClick event is programmatically added to the TOC sheet so that these Sheets can still be referenced via a short cut.

Note that (2) requires that macros are enabled for this approach to work.

Understanding the code

There are 6 major portions in the sample code:

Setting up the Excel environment by disabling screen updating, macros and alert messages

The code tests whether there is an existing TOC sheet by looking for a "marker" range name, Toc_Index. If an existing summary sheet is detected the user is prompted to continue (with Yes & No buttons), pressing "Yes" will delete the current TOC. If the code has not exited then a new sheet is added to the front of the Active Workbook, it is renamed "TOC_Index" and the "marker" range name is added to cell A1 of this worksheet

Each Sheet (other than the new TOC sheet) is tested for its Sheet type, standard worksheets are linked to the TOC sheet via hyperlinks and any other Sheet types are returned to the TOC sheet as values only. A boolean variable bNonWkSht, is used to capture the presence of any sheets that are not Worksheets

Basic code sets up the TOC titles and TOC formatting

If bNonWkSht is True then the Sheet Selection event is programmatically added to the TOC sheet along with a warning that macros must be enabled to provide automatic selection of Chart or Dialog Sheet types

The Excel environment is restored by re-enabling screen updating, macros and alert messages

Using the code

1. Copy the code at the bottom of this Article
2. Open any workbook.
3. Press Alt + F11 to open the Visual Basic Editor (VBE).
4. From the Menu, choose Insert-Module.
5. Paste the code into the right-hand code window.
6. Close the VBE, save the file if desired.

In xl2003 go to Tools-Macro-Macros and double-click CreateTOC
In xl2007 click the Macros button in the Code group of the Developer tab, then click CreateTOC in the list box.

Please note that this code should be run from a regular VBA Code Module.

Option Explicit

Sub CreateTOC()
    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

    For lngSht = 2 To ActiveWorkbook.Sheets.Count
        'set to start at A6 of TOC sheet
        'Test sheets to determine whether they are normal worksheets
        ws.Cells(lngSht + 4, 2).Value = TypeName(ActiveWorkbook.Sheets(lngSht))
        If TypeName(ActiveWorkbook.Sheets(lngSht)) = "Worksheet" Then
            'Add hyperlinks to normal worksheets
            ws.Hyperlinks.Add Anchor:=ws.Cells(lngSht + 4, 1), Address:="", SubAddress:="'" & ActiveWorkbook.Sheets(lngSht).Name & "'!A1", TextToDisplay:=ActiveWorkbook.Sheets(lngSht).Name
        Else
            'Add name of any non-worksheets
            ws.Cells(lngSht + 4, 1).Value = ActiveWorkbook.Sheets(lngSht).Name
            'Colour these sheets yellow
            ws.Cells(lngSht + 4, 1).Interior.Color = vbYellow
            ws.Cells(lngSht + 4, 2).Font.Italic = True
            bNonWkSht = True
        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"))
            .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

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:

Select all Open in new window

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
If you liked this article and want to see more from this author, please click here.

And If you found the article helpful please click on the "Yes" button after the question below.

Regards

Dave
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

Excel VBA to create a Table of Contents (TOC) summary sheet

Introduction

TOC Outputs

Understanding the code

Using the code

table of contents

index

hyperlink

Microsoft Excel Spreadsheet Software

About The Author

More Articles From brettdj

Comments

Add your Comment

Join Experts Exchange Today

Gain Access to all our Tech Resources

Get personalized answers

Access Proven Solutions

Read In-Depth How-To Guides

Watch Step by Step Tutorials

And Much More!

Top MS Excel Experts