Repeating Microsoft Word VBA until no search results found

10
votes

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
3
vbams-word

3 Answers

14
votes

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
2
votes

This can be done without using Do while(lots of extra lines, and space/time wastage), It could be as simple as follows:

Sub SearchFN()

    'Start from The Top
    Selection.HomeKey Unit:=wdStory

    'Find the first search to start the loop
    Do
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "&&FB:*&&FE"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindstop
        .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 found the result then loop started
    If Selection.Find.Found Then

            '' Do your work here
            ' Always end your work after the first found result
            ' else it will be endless loop

    Else
    'If we do not found any then it will exit the loop
    Exit Do
    End If
    Loop

End Sub
0
votes

The simplest way to do this is to make the function recursive (the function recalls itself). Add this one line to the bottom of your sub or function:

If (Selection.Find.Found = True) then call SearchFN