• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 369
  • Last Modified:

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
    .Font.Bold = True
    With .Replacement
        .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.
  • 4
  • 4
  • 2
  • +1
1 Solution
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
try to move to end of document after replace

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.
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

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...
Have you tried using wdReplaceOne instead of wdReplaceAll?
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
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
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

        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

jdthedjAuthor Commented:
Thanks DrTribos - that will do what I need.
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 :-)

jdthedjAuthor Commented:
Running backwards didn't make any difference - I tried that too

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 4
  • 4
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now