Chad's Macro Mania
~~Chad K. Welch

Table of Contents in Excel, Part II 

Thanks to those of you who responded with ideas about creating the Table of Contents with page numbers.  Many of you had great thoughts and techniques.  James near Lafayette Louisiana was on the right track and the closest of any to getting a working solution.  Thanks James!  

Before we can begin, we need to find a way to count the printed pages in Excel.  Unfortunately, there isn’t a property or method like: ActiveWorkbook.Pages().Count or ActiveWorkbook.PageNum.  We need to come up with our own method of counting pages.  Existing methods that we will use are:

WorkSheet().HPageBreaks().Count 

and 
WorkSheet().VPageBreaks().Count

As I’m sure you can guess the methods count the number of page breaks.  Consider the following grid representing a worksheet.  Each box of the grid is a different page:  

In this case the worksheet will print on 12 pages.  Counting the page breaks there are two vertical and three horizontal.  Note that none of the borders count as page breaks.  

So, if we add one to both the horizontal page breaks and the vertical page breaks and then multiply the two together we can determine how many pages will print. 

(HPB + 1) * (VPB + 1) =

(3 + 1) * (2 + 1) = 12 pages  

Now we’ve just got to incorporate it into the code.  When pasting this code into your own application, remember to delete the line numbers.  I’ve just added them for reference.   

1. Sub TableOfContents()

2.     Dim ws As Worksheet, wsTOC As Worksheet

3.     Dim r As Long

4.   

5.     Application.ScreenUpdating = False

6.   

7.     Application.DisplayAlerts = False

8.     On Error Resume Next

9.     Sheets("Table of Contents").Delete

10.    On Error GoTo 0

11.    Application.DisplayAlerts = True

12.   

13.    Set wsTOC = ActiveWorkbook.Worksheets.Add _

14.        (before:=ActiveWorkbook.Sheets(1))

15.    wsTOC.Name = "Table of Contents"

16.   

17.    wsTOC.Range("A1") = "Table of Contents"

18.    wsTOC.Range("A1").Font.Size = 18

19.    wsTOC.Range("A1:D1").MergeCells = True

20.    wsTOC.Range("A3") = "Sheet Name"

21.    wsTOC.Range("B3") = "Page"

22.   

23.    r = 4   'If you change this number, you must

24.            ' change it on line 42 as well

25.    For Each ws In ActiveWorkbook.Worksheets

26.        If ws.Name <> wsTOC.Name And _

27.            ws.Visible = xlSheetVisible Then

28.            wsTOC.Hyperlinks.Add _

29.                anchor:=wsTOC.Cells(r, 1), _

30.                Address:="", _

31.                SubAddress:=""ws.Name & "!A1", _

32.                TextToDisplay:=ws.Name

33.            r = r + 1

34.        End If

35.    Next

36.   

37.    'Now we're ready to insert page numbers!

38.   

39.    Dim PageCount As Integer, PageNum As Integer

40.   

41.    PageNum = 1     'Initialize the starting page.

42.    r = 4           'reset our starting row.

43.    For Each ws In ActiveWorkbook.Worksheets

44.        If ws.Visible = xlSheetVisible Then

45.            If ws.Name <> wsTOC.Name Then

46.                wsTOC.Cells(r, 2) = PageNum

47.                r = r + 1

48.            End If

49.       

50.            PageCount = (ws.HPageBreaks().Count + 1) * _

51.                (ws.VPageBreaks().Count + 1)

52.            PageNum = PageNum + PageCount

53.        End If

54.    Next

55.   

56.    wsTOC.Cells.Columns.AutoFit

57.   

58.    Application.ScreenUpdating = True

59.   

60. End Sub  

Some of the code shown above has already been discussed 2 issues ago.  Please refer to it if you have any questions. 

The first part to discuss is found on lines 7 to 11

7.     Application.DisplayAlerts = False

8.     On Error Resume Next

9.     Sheets("Table of Contents").Delete

10.    On Error GoTo 0

11.    Application.DisplayAlerts = True

If you have created a TOC and try to rerun the code, you will get an error because the page already exists.  This segment of code will delete the Table of Contents if it exists (assuming the sheet is called “Table of Contents”).  Line 7 and 11 turn the alerts on and off respectively.  Whenever you delete a sheet a warning is displayed asking if you are sure.  We don’t want that to occur here so the alerts are turned off temporarily.   Lines 8 and 10 deal with error handling which will be discussed in a future issue.  For now just understand that if there is not a sheet called Table of Contents and our macro tried to delete it an error would occur.  Line 8 tells the macro to ignore any errors occurring after that point and line 10 tells it to once again check and stop on errors.  Line 9 is pretty straight forward; it deletes the sheet named “Table of Contents.” 

Line 39 declares more variables used to count pages.  Some programmers will argue that it is poor coding to declare any variables except at the top of the procedure.  However, as you can see, it can be done nearly anywhere and for sake of clarity.  I’ve declared them near the code that will be using the variables.

39.    Dim PageCount As Integer, PageNum As Integer  

Line 41 initializes PageNum to 1.  If you don’t want to count the TOC in your page numbering then set it equal to zero.  Line 42 resets the starting row.  This number should be the same number as is found on line 23.

41.    PageNum = 1     'Initialize the starting page.

42.    r = 4           'reset our starting row.  

Line 46 places the PageNum into column B for the appropriate worksheet.

46.                wsTOC.Cells(r, 2) = PageNum  

Line 50 and 51 is where we’ve inserted the formula from above.  It counts the horizontal and vertical page breaks, adds one to both of them and then multiplies them together, giving us the number of pages on that worksheet.  Line 52 adds the PageCount for the current worksheet to the total PageNum for the workbook.

50.        PageCount = (ws.HPageBreaks().Count + 1) * _

51.            (ws.VPageBreaks().Count + 1)

52.        PageNum = PageNum + PageCount  

After running the macro you will have a Table of Contents with hyperlinks to each worksheet plus an accurate Table of Contents for the printed version of your workbook. 

Make Money$$$  What would you like to see in this section of ABC?  Email your request to chad@welchkins.com with the subject "Idea for ABC".   If you are the first person to submit the idea and I use it, I will pay you $5.00.  (Okay, I know it isn’t much, but hey, I’m no millionaire, and I have no sponsor.  The money comes from my wallet, meager as it is).  Remember, the idea should be about VBA or automating tasks in Microsoft Office programs.

Chad K. Welch works as a technician/enabler in Utah.  He is available for consulting or application programming with Microsoft Office and VBA.  Do you have a question or tip you’d like to have Chad address in this column?  Send an email to linda@personal-computer-tutor.com or contact him directly at chad@welchkins.com for more information.