Proper Excel Table of Contents (ToC)

[judicial85]

The code shown below was taken from the Excel Blog as my Excel tabs are becoming difficult to manage. Would anybody know how to modify it so that the iterations include tabs that are exclusively charts? Right now it only counts/links to spreadsheet pages.

Alternatively, if there is a really nice ToC code out there or tab organizing Add-In or code, could you share the link?



Thanks! Bryan

Option Explicit

Sub Create_TOC() 
Dim wbBook As Workbook 
Dim wsActive As Worksheet 
Dim wsSheet As Worksheet

Dim lnRow As Long 
Dim lnPages As Long 
Dim lnCount As Long

Set wbBook = ActiveWorkbook

With Application 
    .DisplayAlerts = False 
    .ScreenUpdating = False 
End With

'If the TOC sheet already exist delete it and add a new 
'worksheet.

On Error Resume Next 
With wbBook 
    .Worksheets("TOC").Delete 
    .Worksheets.Add Before:=.Worksheets(1) 
End With 
On Error GoTo 0

Set wsActive = wbBook.ActiveSheet 
With wsActive 
    .Name = "TOC" 
    With .Range("A1:B1") 
        .Value = VBA.Array("Table of Contents", "Sheet # - # of Pages") 
        .Font.Bold = True 
    End With 
End With

lnRow = 2 
lnCount = 1

'Iterate through the worksheets in the workbook and create 
'sheetnames, add hyperlink and count & write the running number 
'of pages to be printed for each sheet on the TOC sheet. 
For Each wsSheet In wbBook.Worksheets 
    If wsSheet.Name <> wsActive.Name Then 
        wsSheet.Activate 
        With wsActive 
            .Hyperlinks.Add .Cells(lnRow, 1), "", _ 
            SubAddress:="'" & wsSheet.Name & "'!A1", _ 
            TextToDisplay:=wsSheet.Name 
            lnPages = wsSheet.PageSetup.Pages().Count 
            .Cells(lnRow, 2).Value = "'" & lnCount & "-" & lnPages 
        End With 
        lnRow = lnRow + 1 
        lnCount = lnCount + 1 
    End If 
Next wsSheet

wsActive.Activate 
wsActive.Columns("A:B").EntireColumn.AutoFit

With Application 
    .DisplayAlerts = True 
    .ScreenUpdating = True 
End With

End Sub