Tuesday, 25 November 2014

How to Create Table of Contents and Index for a Report in Excel with VBA Macro

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>
    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
    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
   ActiveSheet.Rows("1:1").RowHeight = 30.75
   ActiveSheet.Columns("A:A").ColumnWidth = 16.29

'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). _
        .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
        .Size = 11
        .Name = "+mn-lt"
   End With
'Adding the Hyperlink to Shape targeting to INDEX Tab
    ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", _
    SubAddress:="'" & Sheets(1).Name & "'!A1", TextToDisplay:=""
Next K
    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 :

No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts