Word 2016 VBA loop until end of document

Question

I've looked at many different answers online but have not been able to find a solution that fits my code. This is my first time writing VBA in Word (have some moderate experience in Excel).

I thought this post might be what I need but it doesn't stop the loop at the end of the document for me.

I'm trying to insert a continuous section break before the start of a new section, which I designate as text that is formatted with style Heading 1. I'm totally open to doing this another way and would be grateful for your insights!

Sub InsertSectionBreak()
    ' Go to start of document
    Selection.HomeKey Unit:=wdStory

    ' Find next section based on header formatting, insert continuous section break just before
    '
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    Do While Selection.Find.Execute = True
        Selection.Find.Execute
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.InsertBreak Type:=wdSectionBreakContinuous
    Loop
End Sub

Answer 1

The code in the question is not bad, but has a major problem: The Selection is being moved towards the front of the document in order to insert the Section Break. This means that next time Find runs it again finds the same Heading 1 and thus repeatedly inserts Section Breaks in the same place.

The other problem is that the code is executing Find as part of the Do While criterium (which is why it's not finding the first instance of Heading 1 in the document).

The following code sample works with Range objects instead of the Selection. You can think of a Range like an invisible selection with a very important difference: there can be multiple Ranges; there can be only one selection.

The suggested code uses two ranges: one for the Find and the other for inserting the Section Break. The Find range is set to the entire document. Whether the Find is successful is stored in a boolean variable (bFound).

If Find is successful the found range is duplicated to the range for the Section break. Duplicate makes an independent "copy" of the original range so that they can be manipulated independently of one another. The range for the section break is then collapsed to its starting point (think of it like pressing left-arrow), then the section break is inserted.

The Find range, however, is collapsed to its end point in order to move it beyond the text formatted with Heading 1 so that the next Heading 1 can be targeted. Find is then executed again and the loop repeats until no more instances of Heading 1 are found.

Sub InsertSectionBreak()
    Dim rngFind As Word.Range, rngSection As Word.Range
    Dim bFound As Boolean

    Set rngFind = ActiveDocument.content

    ' Find next section based on header formatting, insert continuous section break just before
    '
    rngFind.Find.ClearFormatting
    rngFind.Find.style = ActiveDocument.styles("Heading 1")
    With rngFind.Find
        .text = ""
        .Replacement.text = ""
        .Forward = True
        .wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        bFound = .Execute
    End With

    Do While bFound
        Set rngSection = rngFind.Duplicate
        rngSection.Collapse wdCollapseStart
        rngSection.InsertBreak Type:=wdSectionBreakContinuous
        rngFind.Collapse wdCollapseEnd
        bFound = rngFind.Find.Execute
    Loop
End Sub

Answer 2

If the content you're interested is related to a heading, you can obtain all the content under that heading without the need for Section breaks. For example:

Sub GetHeadingSpanText()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the text to find?")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  If .Find.Found = True Then
    Set Rng = .Paragraphs(1).Range
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    MsgBox Rng.Text
  End If
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Note that this approach get's all the content associated with the nearest heading, regardless of its level; a more sophisticated approach can be use to get all the content associated with a particular heading level so that, if the match is found under a sub-heading, the prior major heading is used to determine the range spanned.