Repeating Microsoft Word VBA until no search results found

ms-word, vba

Solution

Good question this one, you can loop through the whole document using the `Selection.Find.Found` result.

What you do is start a search and if you find a result go into a loop only while the `Selection.Find.Found` result is true. Once you've got through these, you're done. The following code should do the trick nicely for you.

Sub SearchFN()
    Dim iCount As Integer

    'Always start at the top of the document
    Selection.HomeKey Unit:=wdStory

    'find a footnote to kick it off
    With Selection.Find
        .ClearFormatting
        .Text = "&&FB:*&&FE"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
        .Execute
    End With

    'If we find one then we can set off a loop to keep checking
    'I always put a counter in to avoid endless loops for one reason or another
    Do While Selection.Find.Found = True And iCount < 1000
        iCount = iCount + 1

        'Jump back to the start of the document.  Since you remove the
        'footnote place holder this won't pick up old results
        Selection.HomeKey Unit:=wdStory
        Selection.Find.Execute

        'On the last loop you'll not find a result so check here
        If Selection.Find.Found Then

            ''==================================
            '' Do your footnote magic here
            ''==================================

            'Reset the find parameters
            With Selection.Find
                .ClearFormatting
                .Text = "&&FB:*&&FE"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchKashida = False
                .MatchDiacritics = False
                .MatchAlefHamza = False
                .MatchControl = False
                .MatchByte = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchFuzzy = False
                .MatchWildcards = True
            End With
        End If
    Loop
End Sub

Problem

I've created a MS Word macro that searches for certain text (indicated by markup codes), cuts the text and inserts it into a new footnote, and then deletes the markup codes from the footnote. Now I want the macro to repeat until it doesn't find any more markup codes in the text. Here's the macro below ``` Sub SearchFN() 'find a footnote Selection.Find.ClearFormatting With Selection.Find .Text = "&&FB:*&&FE" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchFuzzy = False .MatchWildcards = True End With Selection.Find.Execute 'cut the footnote from the text Selection.Cut 'create a proper Word footnote With Selection With .FootnoteOptions .Location = wdBottomOfPage .NumberingRule = wdRestartContinuous .StartingNumber = 1 .NumberStyle = wdNoteNumberStyleArabic End With .Footnotes.Add Range:=Selection.Range, Reference:="" End With 'now paste the text into the footnote Selection.Paste 'go to the beginning of the newly created footnote 'and find/delete the code for the start of the note (&&FB:) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "&&FB:" .Replacement.Text = "" .Forward = False .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchFuzzy = False .MatchWildcards = True End With Selection.Find.Execute With Selection If .Find.Forward = True Then .Collapse Direction:=wdCollapseStart Else .Collapse Direction:=wdCollapseEnd End If .Find.Execute Replace:=wdReplaceOne If .Find.Forward = True Then .Collapse Direction:=wdCollapseEnd Else .Collapse Direction:=wdCollapseStart End If .Find.Execute End With 'do same for ending code (&&FE) With Selection.Find .Text = "&&FE" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchFuzzy = False .MatchWildcards = True End With Selection.Find.Execute With Selection If .Find.Forward = True Then .Collapse Direction:=wdCollapseStart Else .Collapse Direction:=wdCollapseEnd End If .Find.Execute Replace:=wdReplaceOne If .Find.Forward = True Then .Collapse Direction:=wdCollapseEnd Else .Collapse Direction:=wdCollapseStart End If .Find.Execute End With Selection.HomeKey Unit:=wdStory 'now repeat--but how?? End Sub ```

Original source