0
votes

I've recorded a macro to, find a specific search term "INCLUDETEXT" in a large document, highlight the text associated with that search term, convert the highlighted text to a field code, and then update the new field code.

I need to loop the macro until the "INCLUDETEXT" term is not found.

I've tried to repeat the code 50 times, but ended up with odd nested field codes on the last instance of the "INCLUDETEXT" term.

Sub InsertFields()
'
' InsertFields Macro
' Inserts field codes associated with an "INCLUDETEXT" link.
'
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "INCLUDETEXT"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.Fields.Update
End Sub

The macro works on each single instance of the search term. I would like to find and update all "INCLUDETEXT" terms.

I have looked at Repeating Microsoft Word VBA until no search results found, but could not figure out how to adapt my macro to fit.

My failed attempt at a "Do If" loop. I believe the specific error was an "End If" without an "If":

Sub InsertFields()
'
' InsertFields Macro
' Inserts all fields associated with an "INCLUDETEXT" link.
' Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "INCLUDETEXT"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Do While Selection.Find.Found = True
    Selection.Find.Execute
    If Selection.Find.Found Then
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.Fields.Update
    End If
    Loop
End Sub
1
Hi @CindyMeister. Sorry, I didn't see the edit option earlier. I've corrected this. I did manage to set a loop using the basic code: "Dim x As Integer", "For x = 1 To 40", and "Next x". The issue is that I would rather not have to change the maximum "x" to match the number of fields to be inserted each time. That's why a "Do If" loop would be better.Scout495
Scout, please do try the code again and report exactly how it's not working. I see nothing, right off-hand, that would cause the error message you sort-of-think-you-saw. What I do see is that a Selection.Find.Execute is needed before the Do While line, otherwise this will evaluate to False so the loop won't run; and then put Selection.Find.Execute just before the Loop line. OR put the evaluation at the end of the loop (Loop While Selection.Find.Found). Then you should no longer need the If...End If linesCindy Meister
@CindyMeister, you are fantastic! I did retry the original macro and it error out, but didn't do anything either. I took your advice and moved the Selection.Find.Execute before the Do While line and then another Selection.Find.Execute just before the Loop. The macro now runs perfectly! THANK YOU!Scout495

1 Answers

0
votes

I moved the Selection.Find.Execute before the Do While line and then added another Selection.Find.Execute just before the End IF and Loop.

Sub InsertFields()
'
' InsertFields Macro
' Inserts all fields associated with an "INCLUDETEXT" link.
' Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "INCLUDETEXT"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Do While Selection.Find.Found = True
    If Selection.Find.Found Then
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.Fields.Update
    Selection.Find.Execute
    End If
    Loop
End Sub