How to create Table of Contents sheet

[Balerina]

Hi,
Can we create table to contents (may be in the very first sheet of the workbook) and display the list of sheet names being added and provide a hyperlink so that, when clicked in the first sheet it goes to the respective sheets.

Thanks in Advance.

 

[VoG]

Try

Sub IDX()
Dim ws As Worksheet, i As Integer
Worksheets.Add(before:=Worksheets(1)).Name = "Index"
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Index" Then
        i = i + 1
        Sheets("Index").Range("A" & i).Value = ws.Name
        Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
Next ws
Sheets("Index").Columns("A").AutoFit
End Sub

 

[Balerina]

Hi,
This is ok if i am creating the index sheet for the very first time. Suppose that i am running the application for the second time and i already have a index sheet in my workbook and 4sheets has already been added and are provided with hyperlink. Now if i am going to add the next sheet (that will be my 5th sheet in the workbook) then how to handle that situation?
Please guide me.

Try

Sub IDX()
Dim ws As Worksheet, i As Integer
Worksheets.Add(before:=Worksheets(1)).Name = "Index"
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Index" Then
        i = i + 1
        Sheets("Index").Range("A" & i).Value = ws.Name
        Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
Next ws
Sheets("Index").Columns("A").AutoFit
End Sub

 

[VoG]

Try

Sub IDX()
Dim ws As Worksheet, i As Integer
If WorksheetExists("Index") Then
    Worksheets("Index").UsedRange.ClearContents
Else
    Worksheets.Add(before:=Worksheets(1)).Name = "Index"
End If
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Index" Then
        i = i + 1
        Sheets("Index").Range("A" & i).Value = ws.Name
        Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
Next ws
Sheets("Index").Columns("A").AutoFit
End Sub


Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

 

[Balerina]

what if i dont want to clear the contents of the Index sheet every time as my workbook contains lot many number of sheets. Each time deleting all the contents and recreating them may take time. I just want to append the newly created sheets to the existing table of contents.

Actually i tried making the following changes in the code. it was woking but when ever the new sheets are careted, the old hyperlinks are getting disappeared and hyperlinks for the new sheets getting activated.
Can you please suggest on this?


Sub IDX()
Dim ws As Worksheet, i As Integer
If WorksheetExists("Index") Then
' Worksheets("Index").UsedRange.ClearContents //i commented this line
i = Worksheets("Index").UsedRange.Rows.Count // i added this line
Else
Worksheets.Add(before:=Worksheets(1)).Name = "Index"
End If
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Index" Then
i = i + 1
Sheets("Index").Range("A" & i).Value = ws.Name
Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
End If
Next ws
Sheets("Index").Columns("A").AutoFit
End Sub

Try

Sub IDX()
Dim ws As Worksheet, i As Integer
If WorksheetExists("Index") Then
    Worksheets("Index").UsedRange.ClearContents
Else
    Worksheets.Add(before:=Worksheets(1)).Name = "Index"
End If
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Index" Then
        i = i + 1
        Sheets("Index").Range("A" & i).Value = ws.Name
        Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
Next ws
Sheets("Index").Columns("A").AutoFit
End Sub


Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

 

[VoG]

I just timed the last code that I posted and it took less than 0.2 seconds to index 20 sheets.

 

[Balerina]

Actually in my Index sheet other tahn providing the hyperlinks, i need to add some other data also. So as per my requirement i prefer not deleting the contents of Index sheets rather i want to append to the existing contents without the previous hyperlinks getting disturbed.