Need to loop find and replace

[djl0525]

I recorded this macro in Word 2007. It replaces text and highlights the new text in yellow. I copied and pasted it to replace three text strings. It works great, except that I have hundreds of text strings to replace. I need a loop or something. Can somebody edit this code for me so I can type in my before and after text more easily, please?



Sub ReplaceFilenames()
'
' Macro1 Macro
'
'
'#1 - REPLACE GREEN
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "xgreenx"
.Replacement.Text = "green green"
End With

Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
Selection.Range.HighlightColorIndex = wdYellow
End With

'#2 - REPLACE BLUE
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "xbluex"
.Replacement.Text = "blue blue"
End With

Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
Selection.Range.HighlightColorIndex = wdYellow
End With

'#3 - REPLACE RED
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "xredx"
.Replacement.Text = "red red"
End With

Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
Selection.Range.HighlightColorIndex = wdYellow
End With
End Sub



Thanks! --DJ

[fumei]

1. why are you using Selection? Bad idea, although that is what happens when you record macros. What - exactly - are you trying to do?

2. please clarify. Do you know the strings in adance? Can you supply a given list (be it 3 or 100) to a macro? If so, then something like:Sub ReplaceColours()
Dim r As Range
Dim colours() As String
Dim var
colours = Split("blue,green,red", ",")
For var = 0 To UBound(colours())
Set r = ActiveDocument.Range
With r.Find
Do While .Execute(Findtext:="x" & colours(var) & "x", _
Forward:=True) = True
r.Text = colours(var) & " " & colours(var)
r.HighlightColorIndex = wdYellow
r.Collapse 0
Loop
End With
Next var
End Sub
will work. Demo attached. Click "Replace Colours" on top toolbar. I am not sure about the ReplaceOne you have. This replaces all. It coul deasily be changed to actioning each item only once. The list used can be changed by simply changing the array used.

The current array is "blue, green,red"

Change that to: "blue,green,red,yadda,blah,whatever,hohum,Benny Goodman,eccisiastical orbits,Dobermans,rabbits" and THOSE - plus adding "x" to the start and end - will be searched for, and replaced/highlighted. That is the only thing you have to do; change the contents of the Split instruction.

[djl0525]

Thank you fumei, for your reply and the attached file.


What - exactly - are you trying to do? Replace text and highlight the replacement text.


Do you know the strings in adance? Can you supply a given list (be it 3 or 100) to a macro? Yes. I have a list of a couple hundred filenames that I need to replace. I can supply them to the macro. I'll edit the list in Word and copy and paste to the macro.


I am not sure about the ReplaceOne you have. That came from recording the macro.

I'm afraid my sample was misleading and I apologize for the confusion. I am replacing filenames referenced in the document. The before and after filenames have nothing in common. I could be replacing "Benny Goodman.doc" with "eccisiastical orbits.xls". I need to supply the before and after filenames to the macro.

Your help is greatly appreciated! -- DJ :)

[fumei]

"I'm afraid my sample was misleading "

..........mmmmmmm, yes.

" I need to supply the before and after filenames "

Ah. That is hugely significant. Tell me the logic, and I can tell you how to do it.

I have NO idea of what you may be using as logic for something like:

Benny Goodman.doc --> eccisiastical orbits.xls

How is this determined??? But again, if you know what they are, and you can make them match EXACTLY - repeat EXACTLY - then it is not too difficult. By matching exactly, I mean precisely that.

Array_1

Benny Goodman.doc
Harry Belefonte.doc
Golda Meir.doc
YaddaYadda.doc
....etc.

for a total of 100 items listed.

Now.........


Array_2
eccisiastical orbits.xls
GrandCanyon.xls
peekAboo.ppt
SayWHAT.doc
....etc

for a toal of 100 items.

With the two arrays, logically item 0 (they are zero-based) of Array_1 = item 0 of Array_2, thus:

Benny Goodman.doc --> eccisiastical orbits.xls
Harry Belefonte.doc-->GrandCanyon.xls
Golda Meir.doc-->peekAboo.ppt
YaddaYadda.doc-->sayWHAT.doc
Do While .Execute(Findtext:=Array_1(var), _
Forward:=True) = True
r.Text = Array_2(var)
r.HighlightColorIndex = wdYellow
r.Collapse 0
Loop

[djl0525]

Background:
The document is a training manual. It references many filenames like Lesson1.3.docx. I spent hours in Excel cross referencing numbers like 1.3 to the topics in the manual and came up with a more user-friendly name for each file. I used Excel to create the contents of a batch file which renamed hundreds of files for me in Windows. Lesson1.3.docx may have become 1.3 How To Create A Table of Contents.docx. Now, I need to update the manual by changing all the referenced files to their new filenames. (And they need to be highlighted.) That's why the before and after names are so dissimilar.

I understand the idea of the arrays. How does it all fit together, please? Thanks.

--DJ

[fumei]

It fits together as I stated:

Array_1 matches exactly to Array_2.

Array_1 has: Lesson1.3.docx
Array_2 has: 1.3 How To Create A Table of Contents.docx

To work they MUST have the same array index number, so that

Array_1(54) = Lesson1.3.docx
Array_2(54) = 1.3 How To Create A Table of Contents.docx

More to the point is how are you getting this data in the first place???

[djl0525]

I understand the idea of the arrays. How does it all fit together, please?

What I mean is, can you post the entire code please so I can copy and paste it into the editor?



More to the point is how are you getting this data in the first place???

Painstakingly. (That's what I thought I explain in the background.) It start out in Word documents. Then I manipulate it in Excel and end up with two lists, before and after. Now I'm ready to copy the lists as arrays into the code.

Can you provide the complete code for me to try? (I don't know what to do with pieces of code.)

Thanks for all your help on this.
--DJ

[djl0525]

Hey Gerry. I hope all is well with you.

Can you post the complete code, please? -- DJ

[Tinbendr]

Now, I need to update the manual by changing all the referenced files to their new filenames. (And they need to be highlighted.)
......
Yes. I have a list of a couple hundred filenames that I need to replace. I can supply them to the macro. I'll edit the list in Word and copy and paste to the macro.Can you provide a sample list? We really don't need an array if the search/replace items are in a list in Word (or Excel).

If they are in a paragraph list separated by a comma, (as long as there are no commas in the topic name. The pipe character is much better.) for example,

Lesson1.3.docx,1.3 How To Create A Table of Contents.docx

we can just loop through the paragraphs, use the Split function for the search/replace properties of the Find.

[djl0525]

I'll describe it here...

Filename: Class Files.xlsx
Sheet name: Filelist
A2:A100 contains the before filenames
B2:B100 contains the after filenames

Can you work with that or do you need me to attach a file?

--DJ

[Tinbendr]

Can you work with that or do you need me to attach a file?
Yes, I can work with that, but the point to uploading a file is so that I/We don't have to recreate a file (for testing) you already have on-hand.

Change paths and filenames accordingly.

Option Explicit


Sub ReplaceFilenames()
'http://word.mvps.org/faqs/interdev/controlxlfromword.htm
'First set a reference to Excel (in the VB Editor, select Tools + References).
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
Dim LastRow As Long
Dim A As Long
Dim Rng As Range

'specify the path and workbook to work on.
WorkbookToWorkOn = ActiveDocument.Path & "\Replace Filenames.xls"

'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")

If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If

On Error GoTo Err_Handler

'If you want Excel to be visible, you could add the line: oXL.Visible = True here;
'but your code will run faster if you don't make it visible.

'Open the workbook
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
Set oSheet = oWB.Worksheets("Filelist")

LastRow = oSheet.Range("A65535").End(xlUp).Row

Set Rng = ActiveDocument.Range

For A = 2 To LastRow
'Replace Text.
With Rng.Find
Do While .Execute(Findtext:=oSheet.Range("A" & A).Text, _
Forward:=True) = True
Rng.Text = oSheet.Range("B" & A).Text
'Make the replaced text highlighted
Rng.HighlightColorIndex = wdYellow
'Reset the range
Set Rng = ActiveDocument.Range
Loop
End With
Next

'Close Excel
If ExcelWasNotRunning Then
oXL.Quit
End If

'Make sure you release object references.
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing

'quit
Exit Sub

Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If

End Sub

[djl0525]

Thanks Tinbendr! It works great. Just what I needed. And thank you for taking the time to attach the files. I sure appreciate it!

--DJ

P.S. Excel is closed when I run the macro and I get a message that Excel has stopped working at the end of the macro. I can live with that. I'll just make sure no other Excel files are open. Thanks again!