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.
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.
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: VB
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
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.