How to add links to all Heading 1 style text?

Question

The code is intended to add the same hyperlink to all Heading 1 style text. (Purpose: clicking any heading brings you to the top of the document).

It works for the first Heading Style text. It does not advance to the next instance.

I found this was due to the line which adds the hyperlink. When this line is removed, all the Heading 1 style text is found (but of course then I can't add the link).

Sub addLinksToAllTextHavingCertainStyle()
Dim r As Range
Set r = ActiveDocument.Content
r.Find.ClearFormatting
Do
    With r.Find
        .Text = ""
        .Replacement.Text = ""
        .Style = "Heading 1"
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .Execute
    End With
    r.Select 'for testing
    ActiveDocument.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:="_top", ScreenTip:=""
Loop
End Sub

Answer 1

You're looping the wrong part of the code. As written your code loops the entire find, which means it just starts over from the beginning each time.

It is only the execution of the Find that needs to be looped, the parameters you have set will remain. When Find is executed the range that the Find is executed on is redefined to the found match, so in a loop you need to collapse the range to the end to avoid the match being endlessly re-found.

Sub addLinksToAllTextHavingCertainStyle()
    Dim r As Range
    Set r = ActiveDocument.Content
    
    With r.Find
        .ClearFormatting
        .Text = ""
        .Replacement.Text = ""
        .Style = "Heading 1"
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
    End With
    Do While r.Find.Execute = True
        ActiveDocument.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:="_top", ScreenTip:=""
        r.Collapse wdCollapseEnd
    Loop
End Sub