TABLE OF CONTENTS NOT USING TABS

[DeanP]

I want to create a table of contents based not on the tab names, but instead the data in a specific cell (B1 - which is the same for all the sheets) as it contains a more detailed description of the sheet. The tab names are abbreviations which would be meaningless to most users.

So far I have found everything I need to create this table of contents except how to loop through all the sheets and get the description in B1 into the TOC.

Any advice appreciated.

[p45cal]

For Each sht In ThisWorkbook.Worksheets
  MsgBox sht.Range("B1").Value
Next sht

[Rob342]

or this way

Dim ws as Worksheet
Dim s as integer
For s = 1 To ThisWorkbook.sheets.Count  'Actual data starts at sheet ?
        sheets(s).Activate
        'MsgBox "The name of the active sheet is " & ActiveSheet.Name
Set ws = Worksheets(ActiveSheet.Name)
        With ws
           'Your code here
        End with
Next s

[Paul_Hossler]

Easy enough to add a hyperlink to go to the sheet. The link text is the B1 for each sheet. I added the ws name in col B, but not needed or you could add more information

Capture.JPG

Option Explicit
Sub MakeTOC()
    Dim wsTOC As Worksheet, ws As Worksheet
    Dim iTOC As Long
    
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Table of Contents").Delete
    Application.DisplayAlerts = False
    On Error GoTo 0
    
    Worksheets.Add Before:=Worksheets(1)
    ActiveSheet.Name = "Table of Contents"
    Set wsTOC = Worksheets("Table of Contents")
    
    iTOC = 1
    
    For Each ws In Worksheets
        If Not ws Is wsTOC Then
            wsTOC.Hyperlinks.Add Anchor:=wsTOC.Cells(iTOC, 1), Address:="", SubAddress:=ws.Name & "!A1", TextToDisplay:="=" & ws.Name & "!B1"
            wsTOC.Cells(iTOC, 2).Value = ws.Name
            iTOC = iTOC + 1
        End If
    Next
    wsTOC.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
End Sub

[david000]

It's nice to have a return link too.

For Each ws In Worksheets
        If Not ws Is wsTOC Then
            wsTOC.Hyperlinks.Add Anchor:=wsTOC.Cells(iTOC, 1), Address:="", SubAddress:=ws.Name & "!A1", TextToDisplay:="=" & ws.Name & "!B1"
            ws.Hyperlinks.Add Anchor:=ws.Cells(1, 1), Address:="", SubAddress:="'Table of Contents'!A1", TextToDisplay:="Back" 'Return Link
            wsTOC.Cells(iTOC, 2).Value = ws.Name
            iTOC = iTOC + 1
        End If
    Next

[Paul_Hossler]

It's nice to have a return link too.

Yea -- I like that

[DeanP]

Thank you all for your help! Much appreciated.