none
Macro to create TOC with hyperlinked tab names RRS feed

  • Question

  • I create TOCs for Excel workbooks with hyperlinks to the corresponding sheet/tab name. For some reason, the macro I use is no longer adding the last sheet to the TOC. I would really appreciate any suggestions - my macro is below.

    Sub CreateINDEX()

    'Declare all variables

    Dim ws As Worksheet, curws As Worksheet, shtName As String

    Dim nRow As Long, i As Long, N As Long, x As Long, tmpCount As Long

    Dim cLeft, cTop, cHeight, cWidth, cb As Shape, strMsg As String

    Dim cCnt As Long, cAddy As String, cShade As Long

    'Check if a workbook is open or not. If no workbook is open, quit.

    If ActiveWorkbook Is Nothing Then

    MsgBox "You must have a workbook open first!", vbInformation, _

    "No Open Book"

    Exit Sub

    End If

    '--------------------------------------------------------

    cShade = 15 '<<== SET BACKGROUND COLOR DESIRED HERE

    '--------------------------------------------------------

    'Turn off events and screen flickering.

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    nRow = 4: x = 0

    'Check if sheet exists already; direct where to go if not.

    On Error GoTo hasSheet

    Sheets("INDEX").Activate

    'Confirm the desire to overwrite sheet if it exists already.

    If MsgBox("You already have a Table of Contents page." _

    & vbLf & vbLf & _

    "Would you like to overwrite it?", _

    vbYesNo + vbQuestion, "Replace INDEX page?") = vbYes Then GoTo createNew

    Exit Sub

    hasSheet:

    x = 1

    'Add sheet as the first sheet in the workbook.

    Sheets.Add before:=Sheets(1)

    GoTo hasNew

    createNew:

    Sheets("INDEX").Delete

    GoTo hasSheet

    hasNew:

    'Reset error statment/redirects

    On Error GoTo 0

    'Set chart sheet varible counter

    tmpCount = ActiveWorkbook.Charts.Count

    If tmpCount > 0 Then tmpCount = 1

    'Set a little formatting for the INDEX sheet.

    ActiveSheet.Name = "INDEX"

    With Sheets("INDEX")

    .Cells.Interior.ColorIndex = cShade

    .Rows("4:65536").RowHeight = 16

    .Range("A1").Value = "Associated Students STAR Request"

    .Range("A1").Font.Bold = False

    .Range("A1").Font.Italic = True

    .Range("A1").Font.Name = "Arial"

    .Range("A1").Font.Size = "10"

    .Range("A2").Value = "Table of Contents"

    .Range("A2").Font.Bold = True

    .Range("A2").Font.Name = "Arial"

    .Range("A2").Font.Size = "24"

    .Range("A4").Select

    End With

    'Set variables for loop/iterations

    N = ActiveWorkbook.Sheets.Count + tmpCount

    If x = 1 Then N = N - 1

    For i = 4 To N

    With Sheets("INDEX")

    shtName = Sheets(i).Name

    'Add a hyperlink to A1 of each sheet.

    .Range("C" & nRow).Hyperlinks.Add _

    Anchor:=.Range("C" & nRow), Address:="#'" & _

    shtName & "'!A1", TextToDisplay:=shtName

    .Range("C" & nRow).HorizontalAlignment = xlLeft

    .Range("B" & nRow).Value = nRow - 2

    nRow = nRow + 1

    End With

    continueLoop:

    Next i

    'Perform some last minute formatting.

    With Sheets("INDEX")

    .Range("C:C").EntireColumn.AutoFit

    .Range("A4").Activate

    End With

    'Turn events back on.

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

    strMsg = vbNewLine & vbNewLine & "Please note: " & _

    "Charts will have hyperlinks associated with an object."

    'Toggle message box for chart existence or not, information only.

    If cCnt = 0 Then strMsg = ""

    MsgBox "Complete!" & strMsg, vbInformation, "Complete!"

    End Sub

    Monday, October 17, 2016 6:28 PM

Answers

  • Re:  TOC code

    Modified lines...

      If x = 1 Then x = 2

      For i = x To N

      .Range("B" & nRow).Value = nRow - 3

      MsgBox "Complete" & strMsg, vbInformation, "Complete   "

    '---
    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Marked as answer by 3Huskies Monday, October 17, 2016 8:20 PM
    Monday, October 17, 2016 7:07 PM

All replies

  • Below lines may cause it

    1.tmpCount = ActiveWorkbook.Charts.Count

    2.If tmpCount > 0 Then tmpCount = 1

    3.N = ActiveWorkbook.Sheets.Count + tmpCount

    4.If x = 1 Then N = N - 1

    5.For i = 4 To N

    1 & 2 - You get total chart sheet in tmpcount then why reducing to 1. If 3 chart sheet then it will become 1

    3.ActiveWorkbook.Sheets.Count gives total sheet count including chart sheet. Then why adding tmpcount again which stored total chartsheets.

    4. Why reducing N to N-1. In any case you have to subtract one sheet because of INDEX sheet which does not need looping

    5. Why starting from 4.


    Best Regards,
    Asadulla Javed,
    Jadavpore & Asansol


    Monday, October 17, 2016 7:00 PM
    Answerer
  • Re:  TOC code

    Modified lines...

      If x = 1 Then x = 2

      For i = x To N

      .Range("B" & nRow).Value = nRow - 3

      MsgBox "Complete" & strMsg, vbInformation, "Complete   "

    '---
    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Marked as answer by 3Huskies Monday, October 17, 2016 8:20 PM
    Monday, October 17, 2016 7:07 PM
  • Re:  toc

    Thanks for marking my post as an answer.
    FWIW, the picture below is my Table of Contents for my code library.
    '---
    Jim Cone
    https://goo.gl/IUQUN2 (Dropbox)




    • Edited by James Cone Wednesday, October 19, 2016 3:23 PM
    Monday, October 17, 2016 9:27 PM