Create automatic index in Word based on Headings with VBA

[johan_wouter]

Hi,

I've made family cookbook in Word and with every new item I'm able to renew the TOC with that new item (recipe). The items in the TOC also have hyperlinks to the specific recipe and every Heading has a hyperlink, that brings you back to the TOC. However, all the recipes are added after the last recipe and this makes the TOC difficult to read.
I would like to create an alphabetical index at the end of my document, with all the headings of recipes and respective pages, and the index items also hyperlinked to the recipes.
I'm a bit at a loss how to do this. I can mark a heading for an index. But how to do this in VBA? Also to mark the index item as an hyperlink?

I would appreciate your help.

I've added the TOC macro below:

Sub UpdateTOC()
' Update TOC and hyperlinks Macro
Application.ScreenUpdating = False
Dim hyp As Hyperlink
Dim toc As TableOfContents
Dim k As Long
Dim bkmk As String
Dim sCode As String
Dim fld As Field
Dim aRange As Range
If ActiveDocument.TablesOfContents.Count = 0 Then
    MsgBox "There are no Tables of Contents in document"
    Exit Sub
End If
If ActiveDocument.TablesOfContents.Count = 1 Then _
   ActiveDocument.TablesOfContents(1).Update
   Set toc = ActiveDocument.TablesOfContents(1)
   For Each fld In toc.Range.Fields
      sCode = fld.Code.Text
      If InStr(sCode, "HYPERLINK") > 0 Then
 bkmk = Mid(sCode, InStr(sCode, "_"))
 bkmk = Left(bkmk, Len(bkmk) - 2)
 fld.Select
 ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
 Name:=bkmk & "R"
 Set aRange = ActiveDocument.Bookmarks(bkmk).Range
 aRange.Select
 With ActiveDocument.Hyperlinks.Add(Anchor:=Selection.Range, _
      Address:="", SubAddress:=bkmk & "R", _
      TextToDisplay:=Selection.Text)
      .Range.Select
      Selection.ClearCharacterAllFormatting
 End With
End If
Next fld
Options.CtrlClickHyperlinkToOpen = False
Selection.GoTo What:=wdGoToBookmark, Name:="Inhoud"
Application.ScreenUpdating = True
End Sub