Table of Contents Maker

[Roderick_E]

This requires 2 macros, one to make the TOC and another to create the link back to the TOC/Main Menu. On screen prompts help user. Will only consider visible tabs. Hide tabs to exclude. It's assumed you would use these macros from a QAT or a form.
This concept has been incorporated into the 20171227 version of XLSuperTool

1) To create TOC, click on a blank tab where you want to put the TOC and run tocmaker. (creates at cell A1 – overwrites on each run)
2) To create link back to TOC/Main Menu, click on a cell on a non-TOC tab and run mmmaker. (Will put link back on all sheets in this same cell, so make sure nothing is there on those sheets)

Sub tocmaker()
Dim wsh As Worksheet
Dim cnt As Long
Dim doit As String
If Application.CountA(ActiveSheet.Range("A:A")) > 0 Then
doit = MsgBox("There is already text in column A of " & ActiveSheet.Name & " where the TOC will be made. This will overwrite data in column A. Do it anyway?", vbYesNo, "ALERT")
If doit <> vbYes Then
Exit Sub
End If
End If
'make toc
ActiveSheet.Range("A1") = "TABLE OF CONTENTS:"
cnt = 2
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Visible = True And wsh.Name <> ActiveSheet.Name Then
ActiveSheet.Cells(cnt, 1) = wsh.Name
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(cnt, 1), Address:="", SubAddress:="'" & wsh.Name & "'!A1", TextToDisplay:=wsh.Name
cnt = cnt + 1
End If
Next
MsgBox "Table of Contents created on " & ActiveSheet.Name & vbCr & "Use MAIN MENU creator to make a return link to main menu."
End Sub

‘----------------------------------------------

Sub mmmaker()
Dim wsh As Worksheet
Dim findany As Variant
Dim doit As String
On Error Resume Next
For Each wsh In ActiveWorkbook.Worksheets
findany = 0
findany = wsh.Cells.Find(What:="TABLE OF CONTENTS:", After:=wsh.Range("A1"), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False).Address
findany = wsh.Cells.Find(What:="TABLE OF CONTENTS:", After:=wsh.Range("A1"), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False).Address
If InStr(findany, "$") > 0 Then
mmname = wsh.Name
End If
Next
Resume Next
 
If mmname = "" Then
MsgBox "No worksheet within " & ActiveWorkbook.Name & " has a Table of Contents: as a cell text. Did you first make a Table of Contents?", vbCritical, "ALERT"
Exit Sub
End If
 
 
If mmname = ActiveSheet.Name Then
MsgBox "Click on a cell on any OTHER tab than the Table of Contents and run this macro.", vbCritical, "ALERT"
Exit Sub
End If
 
mmlink = ActiveCell.Address
doit = MsgBox("This will create a MAIN MENU link on ALL visible sheets in cell " & mmlink & vbCr & "Do you want to do it?", vbYesNo, "ALERT")
If doit <> vbYes Then
Exit Sub
End If
 
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Visible = True And wsh.Name <> mmname Then
wsh.Range(mmlink) = "MAIN MENU"
ActiveSheet.Hyperlinks.Add Anchor:=wsh.Range(mmlink), Address:="", SubAddress:="'" & Sheets(mmname).Name & "'!A1", TextToDisplay:="MAIN MENU"
End If
Next
MsgBox "MAIN MENU linkback created on all visible sheets to link to " & mmname
End Sub