PDA

View Full Version : [SOLVED] TABLE OF CONTENTS NOT USING TABS



DeanP
06-17-2019, 11:48 AM
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
06-17-2019, 12:17 PM
For Each sht In ThisWorkbook.Worksheets
MsgBox sht.Range("B1").Value
Next sht

Rob342
06-17-2019, 12:53 PM
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
06-17-2019, 05:43 PM
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

24409




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
06-18-2019, 05:47 AM
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
06-18-2019, 06:30 AM
It's nice to have a return link too.

Yea -- I like that :clap:

DeanP
06-19-2019, 01:41 AM
Thank you all for your help! Much appreciated.