1. This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn More.

Auto-generate a Table of Contents in Excel

Discussion in 'Visual Basic [VB]' started by pradeep, Mar 13, 2007.

  1. pradeep

    pradeep Team Leader

    Apr 4, 2005
    Likes Received:
    Trophy Points:
    Kolkata, India
    Home Page:
    Here's a cool, handy macro that will auto-generate a Table of Contents for any Excel file.

    Steps remains the same as in any macro (Alt F11 to start VBA, Insert module, paste the code, save, File -> Return to Excel, then Alt F8, and Run). That's a mouthful, but you know what to do.

    Sub GenerateTableOfContents()
    ' Does a TOC already exist?
    ' If Err system variable is > 0, it doesn't
    Dim wSheet As Worksheet
    On Error Resume Next
    Set wSheet = Worksheets("Table of Contents")
    If Not Err = 0 Then
      ' The Table of contents doesn't exist. Add it
      Set wSheet = Worksheets.Add(Before:=Worksheets(1))
      wSheet.Name = "TOC"
    End If
    On Error GoTo 0
    ' Set up the table of contents page
    wSheet.[A2] = "Table of Contents"
    With wSheet.[A6]
      .Value = "Subject"
    End With
    wSheet.[B6] = "Page(s)"
    wSheet.Range("A1:B1").ColumnWidth = Array(36, 12)
    TableRow = 7
    PageCount = 0
    displayMessage =
    "We'll do a Print Preview for some calculations."
    displayMessage = displayMessage&
    "Please ‘Close' the window when it appears."
    MsgBox displayMessage
    ' Now loop thru sheets, collecting TOC info
    For Each S In Worksheets
      ThisName = S.Name
      HPages = S.HPageBreaks.Count + 1
      VPages = S.VPageBreaks.Count + 1
      ThisPages = HPages * VPages
      ' Enter info about this sheet on TOC
      wSheet.Cells(TableRow, 1).Value = ThisName
      wSheet.Cells(TableRow, 2).NumberFormat = "@"
      If ThisPages = 1 Then
        wSheet.Cells(TableRow, 2).Value =
        PageCount + 1&" "
        wSheet.Cells(TableRow, 2).Value =
        PageCount + 1&" - "&PageCount + ThisPages
      End If
      PageCount = PageCount + ThisPages
      TableRow = TableRow + 1
    Next S
    End Sub
    That's all there is to it! Note that VBA does not allow putting the lines after an equal to sign (" = ") on a separate line, although the above code has them so (only to save formatting.)

    Feel free to leave a note if you don't understand some bit of the code and I'll try to explain, though it's quite self-explanatory. The calculation of the number of pages is done through the number of page breaks inside the Print Preview.

Share This Page