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?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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
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
Introduction to R

R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.

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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word

From novice to tech pro — start learning today.