Auto-generate a Table of Contents in Excel

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

  1. pradeep

    pradeep Team Leader

    Joined:
    Apr 4, 2005
    Messages:
    1,645
    Likes Received:
    87
    Trophy Points:
    0
    Occupation:
    Programmer
    Location:
    Kolkata, India
    Home Page:
    http://blog.pradeep.net.in
    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.

    Code:
    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]
      .CurrentRegion.Clear
      .Value = "Subject"
    End With
    wSheet.[B6] = "Page(s)"
    wSheet.Range("A1:B1").ColumnWidth = Array(36, 12)
    TableRow = 7
    PageCount = 0
    Worksheets.Select
    displayMessage =
    "We'll do a Print Preview for some calculations."
    displayMessage = displayMessage&
    "Please ‘Close' the window when it appears."
    MsgBox displayMessage
    ActiveWindow.SelectedSheets.PrintPreview
    
    ' Now loop thru sheets, collecting TOC info
    For Each S In Worksheets
      S.Select
      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&" "
      Else
        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

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice