Word 2016 VBA loop until end of document - vba

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.