VBA macro to replace text line by line

I am using the following macro to replace bolded text in my document.

With ActiveDocument.Content.Find
    .ClearFormatting
    .Font.Bold = True
    With .Replacement
        .ClearFormatting
        .Font.Bold = TRUE
    End With
    .Execute FindText:="Comment", ReplaceWith:="ReplacementComment", _
        Format:=True, Replace:=wdReplaceAll
End With

This works perfectly, but the code is called several times and I am running into the problem of having the text replaced more than once (it changes to the new text, but on the next call it changes it again to something else - not the desired behaviour).

Instead of  wdReplaceAll (the whole document) how do I find and replace the bold text line by line (one line per call)?  The routine is called with parameters ("comment", "replacementcomment")  and those values are read from arrays in a loop.
LVL 3
jdthedjAsked:
Who is Participating?
 
DrTribosCommented:
Here is some code.  The unique bookmark is probably overkill... attributed to ChipPearson.

The find and replace values come from the same array - find value i, replace is value i+1.  To avoid i+1 exceeding the actual size of the array the replace is set to value 0 for the last find operation.

You may wish to clean up the bookmarks after you are done... loop through the collection backwards to do that...

for i = bookmark.count to 1 step - 1 avoids trying to reference the thing you are deleting...

Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Open in new window


Sub EE_Find()

Dim myArr() As String
myArr = Split("bike,car,van,bus", ",")

Dim rng As Range
Dim rngFound As Range

Dim i As Integer
Dim j As Integer
Dim k As Integer

Dim UniqueID As String

Set rng = ActiveDocument.Range

For i = 0 To UBound(myArr)
    
    j = i + 1
    If i = UBound(myArr) Then j = 0
    Set rngFound = rng.Duplicate
        With rngFound.Find
            .Text = myArr(i)
            .Forward = True
            .Wrap = wdFindContinue
            
            Do While .Execute2007
            
                If .Found Then
                    If rngFound.Bookmarks.Count > 0 Then
                        For k = 1 To rngFound.Bookmarks.Count
                            If left(rngFound.Bookmarks(k).name, 3) = "tmp" Then GoTo skipme
                        Next k
                    End If
                    .Parent.Text = myArr(j)
                    Debug.Print rngFound.Start & " " & rngFound.Text
                    ActiveDocument.Bookmarks.Add "tmp" & CreateGUID, rngFound
                End If

            Loop
skipme:
        End With
Next i

End Sub

Public Function CreateGUID() As String
    Dim G As GUID
    With G
    If (CoCreateGuid(G) = 0) Then
    CreateGUID = _
        String$(8 - Len(Hex$(.Data1)), "0") & Hex$(.Data1) & _
        String$(4 - Len(Hex$(.Data2)), "0") & Hex$(.Data2) & _
        String$(4 - Len(Hex$(.Data3)), "0") & Hex$(.Data3) & _
        IIf((.Data4(0) < &H10), "0", "") & Hex$(.Data4(0)) & _
        IIf((.Data4(1) < &H10), "0", "") & Hex$(.Data4(1)) & _
        IIf((.Data4(2) < &H10), "0", "") & Hex$(.Data4(2)) & _
        IIf((.Data4(3) < &H10), "0", "") & Hex$(.Data4(3)) & _
        IIf((.Data4(4) < &H10), "0", "") & Hex$(.Data4(4)) & _
        IIf((.Data4(5) < &H10), "0", "") & Hex$(.Data4(5)) & _
        IIf((.Data4(6) < &H10), "0", "") & Hex$(.Data4(6)) & _
        IIf((.Data4(7) < &H10), "0", "") & Hex$(.Data4(7))
    End If
    End With
End Function

Open in new window

0
 
DrTribosCommented:
I don't really understand the situation but you might create a new style to mark text that you wish to avoid on subsequent calls.

Sorry for the brevity - using phone
0
 
FarWestCommented:
try to move to end of document after replace

ActiveDocument.Characters.Last.Select
0
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

 
jdthedjAuthor Commented:
Thanks for the replies

@DrTribos - I don't want to change the style - it needs to remin the same, but with new text.

@fryezz - that would not work because the next time the routine is called it will start again at the beginning of the text.
0
 
DrTribosCommented:
Hi - you can make the style a duplicate of the style you are using, call it tmpStyle.  Then you can tidy up at the end by looking for your tmpStyle and changing it back to whatever it is supposed to be....

Otherwise you could use bookmarks...
0
 
GrahamSkanRetiredCommented:
Have you tried using wdReplaceOne instead of wdReplaceAll?
0
 
FarWestCommented:
if this is one time task (i.e. the document should run the script once and only once) then you just add something in the subject field (or any document property field after first run then check for the value to prevent second run
0
 
jdthedjAuthor Commented:
Thanks for all the replies

@DrTribos  are you able to give me some sample code please?   The text to be replaced is always bold, and no other text is bold.  The problem is that when for example the code finds  "Car" it changes it to a "Truck" the first time round, but then finds it the second time as a "Truck" and wants to change it to a "Van" etc
0
 
jdthedjAuthor Commented:
Thanks DrTribos - that will do what I need.
0
 
DrTribosCommented:
Yup, I expected so, thanks for the prompt close out and grade.  

I was wondering if you'd simply be able to run your find & replace in the reverse order to avoid the issue?   Either way I had (perverse) fun solving :-)

Cheers,
0
 
jdthedjAuthor Commented:
Running backwards didn't make any difference - I tried that too
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.