MrExcel.com - Your One Stop for Excel Tips & Solutions

Table Of Contents Macro

November 26, 2002 - by

Thanks to Matt who sent this week's Excel question:

I have a large and growing Excel workbook (lots of sheets). I have included page numbers in the footer while printing, however it is getting harder and harder to navigate when we are in a meeting. Is there a way to print a table of contents based on Excel worksheet names so I and the staff can quickly turn to page #xx?

This is a great idea. The first simple suggestion is to include the sheet name in the footers of your printout. When you click on "Custom Footer" in the Page Setup / Header Footer dialog, there are 7 icons. The rightmost icon looks like an index card with three tabs. Clicking in the Right section: box and hitting that icon will cause the sheet name to print on each sheet. This alone may help with navigating through the report.

MrExcel likes the idea of having a macro to create the table of contents. The main problem is that Excel does not calculate how many printed pages are on a worksheet until you do a print preview. So, the macro lets the user know that they are about to see a Print Preview and asks them to dismiss it with a click of the close button.

The macro loops through each sheet in the workbook. In it's current state, it collects information from the name of each worksheet. I've also included two other lines which are commented out. If you would rather get the description from the left header or from a title in cell A1, there are sample lines to do either of those as well. Just uncomment the one you want to use.

The macro calculates how many pages by adding one to the number of horizontal page breaks (HPageBreaks.count). It adds one to the number of vertical page breaks (VPageBreaks.Count). It multiplies these two numbers together to calculate the number of pages on that worksheet. If any loyal readers have a better way to do this, please let me know. The current method of counting the page breaks is devilishly slow. I couldn't seem to find a property which tells me how many printed pages there are, but you would think Excel would include one.

The last trick was entering the page range. If a sheet was on pages "3 - 4", Excel would treat this as a date and enter March 4th. By setting the cell format to text with the "@" character, the pages enter properly.

Here is the macro: 

Sub CreateTableOfContents()
    ' Copyright 1999 MrExcel.com
    ' Determine if there is already a Table of Contents
    TOCFound = False
    For Each s In Worksheets
        If s.Name = "Table of Contents" Then
            TOCFound = True
            Exit For
        End If
    Next s
    If Not TOCFound Then
        Sheets.Add Before:=Worksheets(1)
        ActiveSheet.Name = "Table of Contents"
    End If
    
    ' Set up the table of contents page
    TOCRow = 7
    PageCount = 0
    Sheets("Table of Contents").Select
    Range("A2").Value = "Table of Contents"
    Range("A6").CurrentRegion.Clear
    Range("A6").Value = "Subject"
    Range("A6").ColumnWidth = 36
    Range("B6").Value = "Page(s)"
    Range("B6").ColumnWidth = 12
    ' Do a print preview on all sheets so Excel calcs page breaks
    ' The user must manually close the PrintPreview window
    Worksheets.Select
    Msg = "Excel needs to do a print preview to calculate the number of pages. "
    Msg = Msg & "Please dismiss the print preview by clicking close."
    Msgbox Msg
    ActiveWindow.SelectedSheets.PrintPreview
    ' Loop through each sheet, collecting TOC information
    For Each s In Worksheets
        s.Select
	' Use any one of the following 3 lines
        ThisName = ActiveSheet.Name
        'ThisName = Range("A1").Value
        'ThisName = ActiveSheet.PageSetup.LeftHeader
        HPages = ActiveSheet.HPageBreaks.Count + 1
        VPages = ActiveSheet.VPageBreaks.Count + 1
        ThisPages = HPages * VPages
        ' Enter info about this sheet on TOC
        Sheets("Table of Contents").Select
        Range("A" & TOCRow).Value = ThisName
        Range("B" & TOCRow).NumberFormat = "@"
        If ThisPages = 1 Then
            Range("B" & TOCRow).Value = PageCount + 1 & " "
        Else
            Range("B" & TOCRow).Value = PageCount + 1 & " - " & PageCount + ThisPages
        End If
        PageCount = PageCount + ThisPages
        TOCRow = TOCRow + 1
    Next s
End Sub

Below is an equivalent macro, updated with several new macro techniques. 

Sub CreateTableOfContents()
    ' Copyright 2002 MrExcel.com
    ' Determine if there is already a Table of Contents
    ' Assume it is there, and if it is not, it will raise an error
    ' if the Err system variable is > 0, you know the sheet is not there
    Dim WST As Worksheet
    On Error Resume Next
    Set WST = Worksheets("Table of Contents")
    If Not Err = 0 Then
        ' The Table of contents doesn't exist. Add it
        Set WST = Worksheets.Add(Before:=Worksheets(1))
        WST.Name = "TOC"
    End If
    On Error GoTo 0
    
    ' Set up the table of contents page
    WST.[A2] = "Table of Contents"
    With WST.[A6]
        .CurrentRegion.Clear
        .Value = "Subject"
    End With
    WST.[B6] = "Page(s)"
    WST.Range("A1:B1").ColumnWidth = Array(36, 12)
    TOCRow = 7
    PageCount = 0
    ' Do a print preview on all sheets so Excel calcs page breaks
    ' The user must manually close the PrintPreview window
    Msg = "Excel needs to do a print preview to calculate the number of pages. "
    Msg = Msg & "Please dismiss the print preview by clicking close."
    MsgBox Msg
    ActiveWindow.SelectedSheets.PrintPreview
    ' Loop through each sheet, collecting TOC information
' Loop through each sheet, collecting TOC information
    For Each S In Worksheets
        If S.Visible = -1 Then
        S.Select
' Use any one of the following 3 lines
        ThisName = ActiveSheet.Name
        'ThisName = Range("A1").Value
        'ThisName = ActiveSheet.PageSetup.LeftHeader
        HPages = ActiveSheet.HPageBreaks.Count + 1
        VPages = ActiveSheet.VPageBreaks.Count + 1
        ThisPages = HPages * VPages
        ' Enter info about this sheet on TOC
        Sheets("TOC").Select
        Range("A" & TOCRow).Value = ThisName
        Range("B" & TOCRow).NumberFormat = "@"
        If ThisPages = 1 Then
            Range("B" & TOCRow).Value = PageCount + 1 & " "
        Else
            Range("B" & TOCRow).Value = PageCount + 1 & " - " & PageCount + ThisPages
        End If
        PageCount = PageCount + ThisPages
        TOCRow = TOCRow + 1
        End If
    Next S
End Sub

A brief summary of the new macro techniques in the newer macro:

  • It is rarely necessary to select a sheet
  • Rather than looping through each sheet in the workbook looking for a sheet called Table of Contents, the 2nd macro simply assumes it is there and checks the status of the Err variable. If Err is anything other than 0, we know the sheet does not exist and needs to be added.
  • WST is an object variable and is defined to be the Table of Contents worksheet. Thus, any reference to Worksheets("Table of Contents"). can be replaced with WST.
  • The Cells(row, column) construct is more efficient than the kluge of Range("A" & TOCRow). Because Cells() expects numeric parameters, Range("A" & TOCRow) becomes cells(TOCRow, 1)
  • The square brackets are used as a shorthand way of referring to Range("A1").