If you’ve ever needed to generate a hyperlinked table of contents (TOC) for an Excel workbook with more than a few worksheets, you’ll appreciate that it can be quite a laborious task. The following snippet of VBA will iterate over the sheets in a workbook, generating a list of hyperlinks to each sheet in a new sheet at the start of the workbook called “TOC”. If a “TOC” worksheet already exists, the script will ask for a new worksheet name in which to place the table of contents. Typing the same name again will overwrite the contents of the sheet with the TOC. Simple as that.

The code’s fairly run-of-the-mill with one possible exception: the implementation of the SheetExists function. SheetExists takes a string and returns true or false depending on whether a sheet with the specified name already exists in the active workbook. The function uses VBA’s On Error Resume Next statement to achieve this. As per the MSDN documentation, this “specifies that when a run-time error occurs, control goes to the statement immediately following the statement where the error occurred where execution continues.”

As such, in the SheetExists, the call to Sheets(SheetName) would ordinarily throw a “Run-time error 9: Subscript out of range” if the sheet didn’t exist. But with On Error Resume Next the code continues uninterrupted and can check to establish whether the assignment to TestWorksheet was successful or not. If it was, the function return value is set to True, the TestWorksheet variable is set to Nothing (so it can be garbage collected) and On Error GoTo 0 is called to disable the On Error Resume Next. Technically this last step isn’t required as custom error handling is disabled automatically when exiting the Function, but it’s a good practice to get into to avoid leaving run-time errors going unchecked over vast swathes of code.

There’s a gist available here for clones, forks or comments.

Sub GenerateLinkedTOCFromWorkSheetNames()

    Dim ProposedTOCWorksheetName As String
    Dim NewTOCWorksheetName As String
    Dim CurrentWorksheet As Worksheet
    Dim Count As Integer
    
    ProposedTOCWorksheetName = "TOC"
    NewTOCWorksheetName = "TOC"
    RowCounter = 2

    Application.ScreenUpdating = False

    Do While SheetExists(NewTOCWorksheetName)
        NewTOCWorksheetName = Application.InputBox( _
            Prompt:="A sheet named '" & ProposedTOCWorksheetName & "' already exists. " & _
                "Enter a new sheet name or type '" & ProposedTOCWorksheetName & "' to overwrite.", _
            Type:=2)
        
        If NewTOCWorksheetName = ProposedTOCWorksheetName Then
            Exit Do
        End If

        ProposedTOCWorksheetName = NewTOCWorksheetName
    Loop
    
    If SheetExists(NewTOCWorksheetName) Then
        Sheets(NewTOCWorksheetName).Cells.Clear
    Else
        Sheets.Add Before:=Worksheets(1)
        Worksheets(1).Name = NewTOCWorksheetName
    End If

    For Each CurrentWorksheet In Worksheets
        If CurrentWorksheet.Name <> NewTOCWorksheetName Then
            Sheets(NewTOCWorksheetName).Range("B" & RowCounter).Value = CurrentWorksheet.Name
        
            Sheets(NewTOCWorksheetName).Hyperlinks.Add _
                Anchor:=Sheets(NewTOCWorksheetName).Range("B" & RowCounter), _
                Address:="", _
                SubAddress:="'" & CurrentWorksheet.Name & "'!A1", _
                TextToDisplay:=CurrentWorksheet.Name, _
                ScreenTip:=CurrentWorksheet.Name
        
            RowCounter = RowCounter + 1
        End If
    Next
    
    Application.ScreenUpdating = True

End Sub

Function SheetExists(SheetName As String) As Boolean
    
    Dim TestWorksheet As Worksheet
    SheetExists = False
    
    On Error Resume Next
    Set TestWorksheet = Sheets(SheetName)
    If Not TestWorksheet Is Nothing Then SheetExists = True
    Set TestWorksheet = Nothing
    On Error GoTo 0
    
End Function