TABLE OF CONTENTS NOT USING TABS

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.

Code:

---

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

---

or this way

Code:

---

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


---

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

Attachment 24409

Code:

---

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

---

It's nice to have a return link too.

Code:

---

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

---

Quote:

---

Originally Posted by david000

It's nice to have a return link too.

---

Yea -- I like that :clap:

Thank you all for your help! Much appreciated.