Create a Table of Contents in Excel for a Price List

Today’s challenge was to create a table of contents in Excel, for a downloaded price list. The data came from Crystal Reports and had formatting on the section headings. Some of the headings were repeated, but we didn’t want the TOC to include the duplicates.

PriceListHead01

I’ve created a table of contents based on sheet names, in other workbooks, but hadn’t tried to index a sheet’s contents. In this case, all the heading cells were blue, so I decided to create a a TOC entry for any blue cell. A quick test in the Immediate window showed me the colour index — 42.

PriceListColour

The code checks for a TOC sheet, deletes the old one, if it exists, then creates a new TOC sheet. The first instance of each heading is added to the TOC sheet, with a hyperlink to the cell where that heading is located.

The price list has a few hundred product categories, so at the end of the code an AutoFilter is added to the TOC, to make it easier to find the product that you want.

PriceListTOC

The CreateHyperlinks Code

Here’s the code that I used, and you can add your own error handling. You can also download the sample Hyperlink TOC file (Excel 2007 format).

Sub CreateHyperlinks()
Dim c As Range
Dim ws As Worksheet
Dim wsTOC As Worksheet
Dim lRowTOC As Long
Dim lColor As Long
Dim strTOC As String
Dim strHead As String

lRowTOC = 2
lColor = 42
strTOC = "TOC"
strHead = ""

On Error Resume Next
Application.DisplayAlerts = False
Worksheets(strTOC).Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set wsTOC = Worksheets.Add
With wsTOC
  .Name = strTOC
  .Cells(1, 1).Value = "Product"
  .Cells(1, 1).Font.Bold = True
End With

For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> strTOC Then
    For Each c In ws.UsedRange.Columns(1).Cells
      If c.Interior.ColorIndex = lColor Then
        'don't index duplicate headings
        If strHead <> c.Value Then
          wsTOC.Cells(lRowTOC, 1).Value = c.Value
          wsTOC.Hyperlinks.Add _
          Anchor:=wsTOC.Cells(lRowTOC, 1), _
          Address:="", _
          SubAddress:=c.Parent.Name _
          & "!" & c.Address, _
          TextToDisplay:=c.Value
          lRowTOC = lRowTOC + 1
          strHead = c.Value
        End If
      End If        
    Next c
  End If
Next ws

wsTOC.Columns(1).AutoFilter
wsTOC.Columns(1).AutoFit

End Sub

___________________

You may also like...

2 Responses

  1. Claudia says:

    i love this website! wish i had found it sooner!

  2. Tony says:

    I have several workbooks that I need to compile together to track data of last XX years. I was thinking if there is way to have a workbook that receives all data and tabs are made by agency in column “A” (data range is A:G).

    If I add new data I would like to automate the process of dispersing the data between the different tabs by the agency name.

Leave a Reply

Your email address will not be published. Required fields are marked *