Excel VBA Macro to Create Index with Table of Contents in a Report
The following Macro will create an Index Tab called "MY_INDEX" and in this Tab it will create the Table of Contents with list of Sheet names available in ThisWorkbook with Hyperlinks directing you to respective Sheet .
Next in each Tab except <Index Tab> it will create the <Back to Index> button with Hyperlink directing you to <Index Tab>.
Sub Add_My_Index()
Dim K As Long
On Error Resume Next
Application.DisplayAlerts = False
'Deleting an old Index if it already exist with the Name<MY_INDEX>
ThisWorkbook.Sheets("MY_INDEX").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'Adding an Index tab in ThisWorkbook with the Name<MY_INDEX>
ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = "MY_INDEX"
ThisWorkbook.Sheets("MY_INDEX").Cells(1, 1) = "INDEX"
'Adding and formatting the Index title in <MY_INDEX> Tab
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.349986266670736
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 14
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveCell.ColumnWidth = 35
'Looping through other than <MY_INDEX> tab to add <Back to Index> Button.
For K = 2 To Sheets.Count
ThisWorkbook.Sheets("MY_INDEX").Activate
ActiveSheet.Cells(K, 1).Select
ActiveSheet.Hyperlinks.Add _
Anchor:=ActiveSheet.Cells(K, 1), Address:="", _
SubAddress:="'" & Sheets(K).Name & "'!A1", TextToDisplay:=Sheets(K).Name
If Sheets(K).Name = "INDEX" Then GoTo NxtSht
Sheets(K).Activate
ActiveSheet.Rows("1:1").RowHeight = 30.75
ActiveSheet.Columns("A:A").ColumnWidth = 16.29
ActiveSheet.Range("A1").Select
'Adding < Back to Index > button in Other tabs
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 1.5, 2.25, 85.5,25.5).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
Selection.Placement = xlFreeFloating
'Renaming <Shape Name> and Storing the Name in a Variable
Selection.ShapeRange.Name = "Back2Index"
Z = Selection.ShapeRange.Name
'Adding the Text as <Back to Index> in the Shape
Selection.ShapeRange(Z).TextFrame2.TextRange.Characters.Text = "Back to Index"
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 13). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
'Formatting the Shape Color Themes
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 13).Font
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
'Adding the Hyperlink to Shape targeting to INDEX Tab
ActiveSheet.Shapes.Range(Array(Z)).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", _
SubAddress:="'" & Sheets(1).Name & "'!A1", TextToDisplay:=""
ActiveSheet.Range("A2").Select
NxtSht:
Next K
ThisWorkbook.Sheets("MY_INDEX").Activate
ActiveSheet.Cells(1, 1).Select
End Sub
-------------------------------------------------------------------------------
The above Macro will create an Index Tab with Report Index ( Hyper links to each Tab of the Report) as follows :
and in each tab of the report , a <Back to Index> button will be created as follows :
The following Macro will create an Index Tab called "MY_INDEX" and in this Tab it will create the Table of Contents with list of Sheet names available in ThisWorkbook with Hyperlinks directing you to respective Sheet .
Next in each Tab except <Index Tab> it will create the <Back to Index> button with Hyperlink directing you to <Index Tab>.
Sub Add_My_Index()
Dim K As Long
On Error Resume Next
Application.DisplayAlerts = False
'Deleting an old Index if it already exist with the Name<MY_INDEX>
ThisWorkbook.Sheets("MY_INDEX").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'Adding an Index tab in ThisWorkbook with the Name<MY_INDEX>
ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = "MY_INDEX"
ThisWorkbook.Sheets("MY_INDEX").Cells(1, 1) = "INDEX"
'Adding and formatting the Index title in <MY_INDEX> Tab
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.349986266670736
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 14
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveCell.ColumnWidth = 35
'Looping through other than <MY_INDEX> tab to add <Back to Index> Button.
For K = 2 To Sheets.Count
ThisWorkbook.Sheets("MY_INDEX").Activate
ActiveSheet.Cells(K, 1).Select
ActiveSheet.Hyperlinks.Add _
Anchor:=ActiveSheet.Cells(K, 1), Address:="", _
SubAddress:="'" & Sheets(K).Name & "'!A1", TextToDisplay:=Sheets(K).Name
If Sheets(K).Name = "INDEX" Then GoTo NxtSht
Sheets(K).Activate
ActiveSheet.Rows("1:1").RowHeight = 30.75
ActiveSheet.Columns("A:A").ColumnWidth = 16.29
ActiveSheet.Range("A1").Select
'Adding < Back to Index > button in Other tabs
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 1.5, 2.25, 85.5,25.5).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
Selection.Placement = xlFreeFloating
'Renaming <Shape Name> and Storing the Name in a Variable
Selection.ShapeRange.Name = "Back2Index"
Z = Selection.ShapeRange.Name
'Adding the Text as <Back to Index> in the Shape
Selection.ShapeRange(Z).TextFrame2.TextRange.Characters.Text = "Back to Index"
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 13). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
'Formatting the Shape Color Themes
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 13).Font
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
'Adding the Hyperlink to Shape targeting to INDEX Tab
ActiveSheet.Shapes.Range(Array(Z)).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", _
SubAddress:="'" & Sheets(1).Name & "'!A1", TextToDisplay:=""
ActiveSheet.Range("A2").Select
NxtSht:
Next K
ThisWorkbook.Sheets("MY_INDEX").Activate
ActiveSheet.Cells(1, 1).Select
End Sub
-------------------------------------------------------------------------------
The above Macro will create an Index Tab with Report Index ( Hyper links to each Tab of the Report) as follows :
and in each tab of the report , a <Back to Index> button will be created as follows :
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------