Add a Table of Contents sheet to your workbook

In Add a Table of Contents sheet to your workbook, Excel MVP Bill Jelen posted some code for creating a table of contents worksheet in a workbook. To be precise, someone from the Excel team blog posted his code. Let's see if we can't make that code a bit better.

First of all, the Excel team blog needs to have a syntax highlighter, or some simple CSS to prettify the code. Because just puking code onto the screen like that is terrible.

The code

I'm not thrilled about the code itself (To avoid duplicate content, I won't repost the original). The biggest problem is that it doesn't compile (when Option Explicit is at the top of the module).

The other thing I don't like, and I realize this is a quirk of mine, is the unqualified object references. That is where you write "As Worksheet" instead of "As Excel.Worksheet". Even though we're in Excel, I prefer to be more precise to avoid ambiguity with early bound code. It's a habit I've developed over the years and I like it that way.

Another quirk of mine are the cell references that look like this: WST.[A2] — I know it's documented, but how many people actually use this notation regularly? I'd appreciate any clarification on its history.

The code makes several assumptions about existing conditions. For example, the code requires that it be placed inside the workbook you want to use it on. That's pretty inconvenient. I like to keep regularly used code inside my personal workbook, which means I need to edit the existing code to make it work on another workbook.

Also, instead of setting an object reference to the active workbook, the code uses implicit references to the current (active) workbook. About the Worksheets collection, Excel Help says:

Using this property without an object qualifier returns all the worksheets in the active workbook.

Finally, I'm curious about why Print Preview is required, and why each worksheet needs to be selected. I tested the function without these and it counted the number of pages in my sample workbook correctly. Someone please enlighten me.

I have a few other minor issues with the code, but I'll leave that for others to discover.

An alternative

I wrote up my own version of the code. This one is a function that returns the TOC sheet as an object, in case you want to work with it further. It also encapsulates several method calls that really belong in their own function. Put the code anywhere and pass in any workbook for which you want to create a Table of Contents sheet, even the active workbook.

I've reused code where possible, so do let me know if you spot any further opportunities for optimization.

Function CreateTOC(wkbk As Excel.Workbook) As Excel.Worksheet

  Dim WST As Excel.Worksheet
  Dim nextRow As Long
  Dim pageCount As Long
  Dim wksts As Excel.Sheets
  Dim wksht As Excel.Worksheet
  Dim currentSheetName As String
  Dim currentwksht As Excel.Worksheet
  Dim HPages As Long
  Dim VPages As Long
  Dim ThisPages As Long

  If Not IsWorkbookVisible(wkbk) Then
    Exit Function
  End If

  ' loop through sheets
 Set wksts = GetWorksheets(wkbk)

  ' test for existence of Table of Contents sheet
 On Error Resume Next
  Set WST = GetWorksheet(wkbk, "Table Of Contents")

  Application.ScreenUpdating = False

  If Not Err = 0 Then
    ' The Table of contents doesn't exist. Add it
   On Error GoTo 0
    Set WST = AddWorksheet(wkbk, 1)
    WST.Name = "Table Of Contents"
  Else
    ' it does exist!
   On Error GoTo 0
    WST.Cells.Clear
  End If

  For Each wksht In wksts
    If IsWorksheetVisible(wksht) And wksht.Index > 1 Then

      ' set up header range
    WST.Range("A1:B1").Value = Array("Worksheet Name", "Page(s)")

      ' get current sheet
    Set currentwksht = wksht
      currentSheetName = currentwksht.Name

      HPages = currentwksht.HPageBreaks.Count + 1
      VPages = currentwksht.VPageBreaks.Count + 1
      ThisPages = HPages * VPages

      ' Enter info about this sheet on TOC
    nextRow = WorksheetFunction.CountA(WST.Range("A:A")) + 1

      WST.Range("A" & nextRow).Value = currentSheetName

      WST.Range("B" & nextRow).NumberFormat = "@"

      If ThisPages = 1 Then
        WST.Range("B" & nextRow).Value = pageCount + 1 & " "
      Else
        WST.Range("B" & nextRow).Value = pageCount + 1 & " - " & pageCount + ThisPages
      End If

      pageCount = pageCount + ThisPages

    End If
  Next wksht

  WST.Range("A:B").Columns.AutoFit

  Set CreateTOC = WST

  Application.ScreenUpdating = True
End Function

Function IsWorksheetVisible(wksht As Excel.Worksheet) As Boolean
  IsWorksheetVisible = (wksht.Visible = xlSheetVisible)
End Function

Function IsWorkbookVisible(wkbk As Excel.Workbook) As Boolean
  IsWorkbookVisible = Excel.Windows(wkbk.Name).Visible
End Function

Function GetWorksheets(wkbk As Excel.Workbook) As Excel.Sheets
  Set GetWorksheets = wkbk.Worksheets
End Function

Function GetWorksheet(wkbk As Excel.Workbook, _
    sheetName As String) As Excel.Worksheet
  Set GetWorksheet = wkbk.Worksheets(sheetName)
End Function

Function AddWorksheet(wkbk As Excel.Workbook, _
    before As Long) As Excel.Worksheet
  Set AddWorksheet = wkbk.Worksheets.Add(before:=wkbk.Worksheets(before))
End Function

Sample usage

This procedure will add a Table of Contents sheet to every open (and visible) workbook.

Sub TestAddTOC()

Dim wkbks As Excel.Workbooks
Dim wkbk As Excel.Workbook

  Set wkbks = Excel.Workbooks

  For Each wkbk In wkbks
    Call CreateTOC(wkbk)
  Next wkbk

End Sub

Okay, I just have one more thing to add: this isn't really a "table of contents" it's more like a sheet listing with a count of printed pages.

Your thoughts?

Related Articles:

• June 2, 2011 -- Better Worksheets for Printing
• July 13, 2010 -- What columns are filtered?
• September 4, 2009 -- More ways to reference Excel workbooks and sheets using VBA