Home VBA macro to find all instances in a doc of a string, e.g., "a dog", and insert in tracked a reference numeral, e.g., "(102)", immediately afterwards

Questions

VBA macro to find all instances in a doc of a string, e.g., "a dog", and insert in tracked a reference numeral, e.g., "(102)", immediately afterwards

byMR

May 16, 2024

I’d like a VBA macro in word to find all instances of a user-selected string in a document (e.g., "a dog") and insert a corresponding user-selected reference numeral in parentheses (e.g., "(102)") immediately following each string.

I have made a find-and-replace style macro but, in tracked changes, it shows as artificial revisions the deletion and re-insertion of the string itself, whereas I want only the inserted reference numeral to be shown in tracked as a revision.

I’d really appreciate any ideas as to how to show only the reference numerals in tracked, e.g., by adding loops in afterwards to accept specific string deletions and re-insertions, or by using an entirely different approach. I’m stumped.

Here is my inadequate find-and-replace code, which successfully provides tracked reference numerals but does so at the expense of deleting and re-inserting the string itself (which is not what I’m after, since this shows up as artefact revisions in the Word document):

Sub RefNumerals()

Selection.Find.ClearFormatting
feature = InputBox("Type in claim feature:")
refnum = InputBox("Type in reference numeral")
With Selection.Find
.Text = feature
.Replacement.Text = feature & " (" & refnum & ")"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
End Sub

>Solution :

Insert ref number with InserAfter

Sub RefNumerals()
    Dim feature, refnum
    feature = InputBox("Type in claim feature:")
    refnum = InputBox("Type in reference numeral")
    ' feature = "dog" ' for testing
    ' refnum = "100"
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = feature
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        Do While .Execute
            .Parent.InsertAfter " (" & refnum & ")"
            .Parent.Collapse wdCollapseEnd
        Loop
    End With
End Sub