Table of Contents -Help

bekandbri

New Member
Joined
Mar 25, 2020
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
I am looking to create a table of contents page that has:
-Multiple Columns
-Auto updates as tabs are added/deleted
-Has the cell color match the respective tab color
-Creates a hyperlink on each tab directing back to the TOC page

So far, I have found the following codes that have helped create the multiple columns and the hyperlinks. But, I am hoping to find something that will auto-update and change the cell color. I am not a coder (this is the first time I've ever tried to use code) and don't know what any of the stuff means, but hoping someone can help. :) Is it possible to combine all of these into one? Hopefully what I am asking makes sense. Thanks for the help!

Code that I used on a sheet to create TOC page:
VBA Code:
Sub TableOfContents_Create()
'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab (multiple columns)
'SOURCE: [URL='http://www.TheSpreadsheetGuru.com']www.TheSpreadsheetGuru.com[/URL]

Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long, z As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String
Dim shtCount As Long
Dim ColumnCount As Variant

'Inputs
  ContentName = "Contents"

'Optimize Code
Application.DisplayAlerts = False
  Application.ScreenUpdating = False

'Delete Contents Sheet if it already exists
On Error Resume Next
Worksheets("Contents").Activate
  On Error GoTo 0

  If ActiveSheet.Name = ContentName Then
myAnswer = MsgBox("A worksheet named [" & ContentName & _
"] has already been created, would you like to replace it?", vbYesNo)

'Did user select No or Cancel?
If myAnswer <> vbYes Then GoTo ExitSub

'Delete old Contents Tab
Worksheets(ContentName).Delete
  End If

'Count how many Visible sheets there are
For Each sht In ActiveWorkbook.Worksheets
If sht.Visible = True Then shtCount = shtCount + 1
  Next sht

'Ask how many columns to have
ColumnCount = Application.InputBox("You have " & shtCount & _
" visible worksheets." & vbNewLine & "How many columns " & _
    "would you like to have in your Contents tab?", Type:=2)

'Check if user cancelled
  If TypeName(ColumnCount) = "Boolean" Or ColumnCount < 0 Then GoTo ExitSub

'Create New Contents Sheet
  Worksheets.Add Before:=Worksheets(1)

'Set variable to Contents Sheet and Rename
Set Content_sht = ActiveSheet
Content_sht.Name = ContentName

'Create Array list with sheet names (excluding Contents)
  ReDim myArray(1 To shtCount)

  For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> ContentName And sht.Visible = True Then
myArray(x + 1) = sht.Name
x = x + 1
End If
Next sht

'Alphabetize Sheet Names in Array List
For x = LBound(myArray) To UBound(myArray)
For y = x To UBound(myArray)
If UCase(myArray(y)) < UCase(myArray(x)) Then
shtName1 = myArray(x)
shtName2 = myArray(y)
myArray(x) = shtName2
myArray(y) = shtName1
End If
Next y
  Next x

'Create Table of Contents
  x = 1

  For y = 1 To ColumnCount
For z = 1 To WorksheetFunction.RoundUp(shtCount / ColumnCount, 0)
If x <= UBound(myArray) Then
Set sht = Worksheets(myArray(x))
sht.Activate
With Content_sht
.Hyperlinks.Add .Cells(z + 2, 2 * y), "", _
SubAddress:="'" & sht.Name & "'!A1", _
TextToDisplay:=sht.Name

End With
x = x + 1
End If
Next z
  Next y

'Select Content Sheet and clean up a little bit
Content_sht.Activate
Content_sht.UsedRange.EntireColumn.AutoFit
  ActiveWindow.DisplayGridlines = False

'Format Contents Sheet Title
With Content_sht.Range("B1")
.Value = "Table of Contents"
.Font.Bold = True
.Font.Size = 18
  End With

ExitSub:
'Optimize Code
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Code used on the TOC page to create the hyperlinks:
VBA Code:
Sub Contents_Hyperlinks()
'PURPOSE: Add hyperlinked buttons back to Table of Contents worksheet tab
'SOURCE: [URL='http://www.TheSpreadsheetGuru.com']www.TheSpreadsheetGuru.com[/URL]

Dim sht As Worksheet
Dim shp As Shape
Dim ContentName As String
Dim ButtonID As String

'Inputs:
ContentName = "Contents" 'Table of Contents Worksheet Name
ButtonID = "_ContentButton" 'ID to Track Buttons for deletion

'Loop Through Each Worksheet in Workbook
For Each sht In ActiveWorkbook.Worksheets

If sht.Name <> ContentName Then

'Delete Old Button (if necessary when refreshing)
For Each shp In sht.Shapes
If Right(shp.Name, Len(ButtonID)) = ButtonID Then
shp.Delete
Exit For
End If
Next shp

'Create & Position Shape
Set shp = sht.Shapes.AddShape(msoShapeRoundedRectangle, _
          4, 4, 60, 20)

      'Format Shape
shp.Fill.ForeColor.RGB = RGB(91, 155, 213) 'Blue
shp.Line.Visible = msoFalse
shp.TextFrame2.TextRange.Font.Size = 10
shp.TextFrame2.TextRange.Text = ContentName
shp.TextFrame2.TextRange.Font.Bold = True
shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255) 'White

'Track Shape Name with ID Tag
shp.Name = shp.Name & ButtonID

'Assign Hyperlink to Shape
sht.Hyperlinks.Add shp, "", _
SubAddress:="'" & ContentName & "'!A1"

End If

  Next sht

End Sub
 
Last edited by a moderator:

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Forum statistics

Threads
1,215,054
Messages
6,122,893
Members
449,097
Latest member
dbomb1414

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top