Create Sheet “Table of Contents”

Copy the following code in a code Module…
-Selva V Pasupathy, HSBC Global Resourcing, Hyderabad, India

Option Explicit
Function wsExists(wksName As String) As Boolean
  On Error Resume Next
  wsExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
Sub TableOfContents()
'Create a Table of Contents for Active WorkBook
'written by royUK
Visit for more Resources @ https://socko.wordpress.com
More Resources http://selvavinaygam.googlepages.com
28 July 2008
  Dim wSht As Worksheet, wShtTOC As Worksheet
  Dim intRow As Long
  Dim msgResponse As String
  With Application
    .ScreenUpdating = False
    If wsExists("Table of Contents") Then
      msgResponse = MsgBox("TOC exists. Do you wish to recreate it?", vbInformation + vbYesNo, _
                 "J & R Excel Solutions")
      Select Case msgResponse
      Case vbNo
        Exit Sub
      Case vbYes
        .DisplayAlerts = False
        Sheets("Table of Contents").Delete
        Set wShtTOC = ActiveWorkbook.Worksheets.Add(before:=ActiveWorkbook.Sheets(1))
        With wShtTOC
          .Name = "Table of Contents"
          .Range("A1") = "Table of Contents"
          .Range("A1").Font.Size = 14
        End With
        intRow = 3
        For Each wSht In ActiveWorkbook.Worksheets
          If wSht.Name  wShtTOC.Name Then
            wShtTOC.Hyperlinks.Add anchor:=wShtTOC.Cells(intRow, 1), Address:="", _
                         SubAddress:=wSht.Name & "!A1", _
                         TextToDisplay:=wSht.Name
            intRow = intRow + 1
          End If
        Next wSht
      End Select
    Else
      With Application
        .ScreenUpdating = False
        Set wShtTOC = ActiveWorkbook.Worksheets.Add(before:=ActiveWorkbook.Sheets(1))
        wShtTOC.Name = "Table of Contents"
        wShtTOC.Range("A1") = "Table of Contents"
        wShtTOC.Range("A1").Font.Size = 14
        intRow = 3
        For Each wSht In ActiveWorkbook.Worksheets
          If wSht.Name  wShtTOC.Name Then
            wShtTOC.Hyperlinks.Add anchor:=wShtTOC.Cells(intRow, 1), Address:="", _
                         SubAddress:=wSht.Name & "!A1", _
                         TextToDisplay:=wSht.Name
            intRow = intRow + 1
          End If
        Next
      End With
    End If
    .ScreenUpdating = True
    .DisplayAlerts = True
  End With
End Sub

Advertisements

1 Comment »

  1. […] Create Sheet “Table of Contents” […]

RSS feed for comments on this post · TrackBack URI

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: