Solved

VBA macro to replace text line by line

Posted on 2014-12-13
11
303 Views
Last Modified: 2014-12-14
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.
0
Comment
Question by:jdthedj
  • 4
  • 4
  • 2
  • +1
11 Comments
 
LVL 14

Expert Comment

by:DrTribos
ID: 40498601
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
 
LVL 12

Expert Comment

by:FarWest
ID: 40498623
try to move to end of document after replace

ActiveDocument.Characters.Last.Select
0
 
LVL 3

Author Comment

by:jdthedj
ID: 40498630
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
 
LVL 14

Expert Comment

by:DrTribos
ID: 40498632
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
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 40498641
Have you tried using wdReplaceOne instead of wdReplaceAll?
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 12

Expert Comment

by:FarWest
ID: 40498891
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
 
LVL 3

Author Comment

by:jdthedj
ID: 40499078
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
 
LVL 14

Accepted Solution

by:
DrTribos earned 500 total points
ID: 40499308
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
 
LVL 3

Author Closing Comment

by:jdthedj
ID: 40499460
Thanks DrTribos - that will do what I need.
0
 
LVL 14

Expert Comment

by:DrTribos
ID: 40499489
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
 
LVL 3

Author Comment

by:jdthedj
ID: 40499503
Running backwards didn't make any difference - I tried that too
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

I'm writing to share my clumsy experience in using this elegant tool so you can avoid every stupid mistake I made. (I leave it to the authorities to decide if this deserves a place in the Knowledge archives.)  Now that I am on the other side of my l…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
This video walks the viewer through the process of creating Hyperlinks for the web and other documents. Select the "Insert" tab: Click "Hyperlink":  Type "http://" followed by a web address to reference a website or navigate to a document to ref…
Office 365 is currently available in five editions. Three of them are for business use: Office 365 Business Essentials, Office 365 Business, and Office 365 Business Premium. Two of them are for home/personal use: Office 365 Home and Office 365 Perso…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now