Macro for Mass Find and Replace

[jjacobs13]

I am looking for a way to emulate the Find & Replace function in Word.
However, I would like to Find multiple selections and uniquely Replace
each one (after having pasted them each on a new line at the beginning
of the document/template).

For example, I have the word "Bob" and "Jon", and I would like to
replace each occurrence with "George" and "Fred", respectively.

I have the following at the beginning of the document:

Bob
Jon
George
Fred

How would I go about coding a small script for a Macro that would cut
each line and use every two in a Find & Replace function? (Perhaps
even have a textbox appear at the start of the Macro that would request
the number of Find & Replace items.)

 

[jjacobs13]

I guess the words don't have to be pasted at the beginning of the
document. Perhaps just copied/pulled from another Word document.

 

[Doug Robbins - Word MVP]

Use the following type of construction:

Dim vFindText As Variant
Dim vReplText As Variant
Dim sFindText As String
Dim sReplText As String
Dim i As Long

vFindText = Array("one", "two", "three", "four", "five")
vReplText = Array("six", "seven", "eight", "nine", "ten")
For i = LBound(vFindText) To UBound(vFindText)
sFindText = vFindText(i)
sReplText = vReplText(i)
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
.Text = sFindText
.replacement.Text = sReplText
.Execute Replace:=wdReplaceAll
End With
Next i

Or you could put the words to be found in one column of a table and
replacements words in the second column and then iterate through the rows of
the tables, getting the words our of each column and using them for the
sFindText and sReplText in the above.
--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Ann Marie]

Doug was saying,

Or you could put the words to be found in one column of a table and
replacements words in the second column and then iterate through the rows of
the tables, getting the words our of each column and using

--How would you use the table option Doug?
If I have 3 different searches I always did en masse could I ask to call the
..doc file with table.
I am very new at VBA - how would I code this based on the code below and
asking my users which document they would like to call and then running the
below macro?
I sometimes have 4 or 5 lines in my replacement text is that an issue?

Would appreciate some assisstance in how to set up a routine. It sounds
great...

 

[Doug Robbins - Word MVP]

Hi Ann Marie,

Here is the code that I would use. It assumes that the table of words to
find and their replacements is in a document with the filename of source.doc
and in my case, it is located in a folder c:\Documents. You will need to
modify that line of code to suit your setup. It also assumes that the first
row of the table in that document contains a header row, so that the first
word to be found is located in the second row of the table.

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim sFindText As Range
Dim sReplText As Range
Dim i As Long
Dim Source As Document
Dim Target As Document
Set Target = ActiveDocument 'The document in which the replacements are to
be made
Set Source = Documents.Open("c:\documents\source.doc") 'Open the document
containing the table of
'replacements to be made. It assumes that there is a header row in the
table. 'Modify the path and filename to suit.
With Source.Tables(1)
For i = 2 To .Rows.Count
Set sFindText = .Cell(i, 1).Range
sFindText.End = sFindText.End - 1
Set sReplText = .Cell(i, 2).Range
sReplText.End = sReplText.End - 1
Target.Activate
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
.Text = sFindText
.replacement.Text = sReplText
.Execute Replace:=wdReplaceAll
End With
Next i
End With
Source.Close wdDoNotSaveChanges
Target.Activate

End Sub


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Ann Marie]

Hi Doug, that was AWESOME to say the least!

If I could ask another question. I have remmed out the code I want to add -
but not sure I can do this?

1. Run SET SOURCE as a default setting ALWAYS. Permanently set it to run. SO
run your macro with default source.

2. But then ask the user for a NEW source document which is optional and run
the code again with that document name (same path) just new name c:\
"xxxxxx".doc where "xxxxxx" is variable?

Doug, what would be best way to code that? Do I run the macro and call a
duplicate with the Input command?


"Doug Robbins - Word MVP">

Here is the code that I would use. It assumes that the table of words to
find and their replacements is in a document with the filename of
source.doc and in my case, it is located in a folder c:\Documents. You
will need to modify that line of code to suit your setup. It also assumes
that the first row of the table in that document contains a header row, so
that the first word to be found is located in the second row of the table.

Sub ReplaceList()

' Dim strUserData As String

Dim vFindText As Variant
Dim vReplText As Variant
Dim sFindText As Range
Dim sReplText As Range
Dim i As Long
Dim Source As Document
Dim Target As Document
Set Target = ActiveDocument 'The document in which the replacements are to
be made

' strUserData = InputBox("Type file name? c:\, "File Name", "")

 

[Ann Marie]

Hi Doug,

I ran into a slight hitch! I have an inline graphics but all I get is a
square box outline when I run your code. Is it possible to insert an inline
graphic do you know?

Ann

 

[Doug Robbins - Word MVP]

The following modified code will display a message box that allows the user
to select either the default file containing the replacements or if they
click on the No button, it will display the File>Open dialog so that they
can select a file to be used.

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim sFindText As Range
Dim sReplText As Range
Dim i As Long
Dim SourceFile As String
Dim Source As Document
Dim Target As Document
Set Target = ActiveDocument 'The document in which the replacements are to
be made
Dim Msg, Style, Title, Response
Msg = "Do you want to use the default replacements file ?" ' Define
message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Select Source File" ' Define title.
' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
Set Source = Documents.Open("c:\documents\source.doc") 'Open the
document containing the table of
'replacements to be made. It assumes that there is a header row in the
table.
'Modify the path and filename to suit.
Else ' User chose No. Display the FileOpen dialog
With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
SourceFile = ""
MsgBox "You did not select a file."
Exit Sub
Else
SourceFile = WordBasic.FileNameInfo$(.Name, 1)
End If
Set Source = Documents.Open(SourceFile) 'Open the selected document
End With
End If


With Source.Tables(1)
For i = 2 To .Rows.Count
Set sFindText = .Cell(i, 1).Range
sFindText.End = sFindText.End - 1
Set sReplText = .Cell(i, 2).Range
sReplText.End = sReplText.End - 1
Target.Activate
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
.Text = sFindText
.replacement.Text = sReplText
.Execute Replace:=wdReplaceAll
End With
Next i
End With
Source.Close wdDoNotSaveChanges
Target.Activate

End Sub



--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Jen]

Perfect Doug.

The following modified code will display a message box that allows the
user to select either the default file containing the replacements or if
they click on the No button, it will display the File>Open dialog so that
they can select a file to be used.

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim sFindText As Range
Dim sReplText As Range
Dim i As Long
Dim SourceFile As String
Dim Source As Document
Dim Target As Document
Set Target = ActiveDocument 'The document in which the replacements are to
be made
Dim Msg, Style, Title, Response
Msg = "Do you want to use the default replacements file ?" ' Define
message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Select Source File" ' Define title.
' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
Set Source = Documents.Open("c:\documents\source.doc") 'Open the
document containing the table of
'replacements to be made. It assumes that there is a header row in the
table.
'Modify the path and filename to suit.
Else ' User chose No. Display the FileOpen dialog
With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
SourceFile = ""
MsgBox "You did not select a file."
Exit Sub
Else
SourceFile = WordBasic.FileNameInfo$(.Name, 1)
End If
Set Source = Documents.Open(SourceFile) 'Open the selected document
End With
End If


With Source.Tables(1)
For i = 2 To .Rows.Count
Set sFindText = .Cell(i, 1).Range
sFindText.End = sFindText.End - 1
Set sReplText = .Cell(i, 2).Range
sReplText.End = sReplText.End - 1
Target.Activate
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
.Text = sFindText
.replacement.Text = sReplText
.Execute Replace:=wdReplaceAll
End With
Next i
End With
Source.Close wdDoNotSaveChanges
Target.Activate

End Sub



--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[jjacobs13]

How does one go about copying the words into the Array (from another
document and/or pasted into the beginning)?

Thank you for sharing your knowledge.

 

[Greg Maxey]

Say you had a two column table with headings "Find" and "Replace" in a
document named C:\Word List.doc


Sub FillArray()
Dim myArray() As String
Dim oDoc As Word.Document
Dim i As Long
Dim j As Long
Dim pRow As Long
Dim oTbl As Word.Table
Set oDoc = Documents.Open("C:\Word List.doc")
Set oTbl = oDoc.Tables(1)
ReDim myArray(oTbl.Rows.Count - 2, 1) 'Size the array
For pRow = 2 To oTbl.Rows.Count 'Start with 2 to skip the header row
j = j + 1 'For testing only
For i = 1 To 2
myArray(pRow - 2, i - 1) = Left(oTbl.Cell(pRow, i), _
Len(oTbl.Cell(pRow, i).Range.Text) - 2)
Next
Next
oDoc.Close
'Testing
For pRow = 0 To j - 1
For i = 0 To 1
MsgBox myArray(pRow, i)
Next
Next
End Sub

 

[Doug Robbins - Word MVP]

Or just use the method in my message of 8/28/2006 that iterates through the
data in a table.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Jen]

But it won't insert my graphic. Am I able to add extra code when it selects
the col 2 replace text to check to see if there is a graphic or inline
object?

 

[Ann Marie]

Hi Greg,
I'm a little bedazzled by that one - yes it loads the array and messages me
but how does one call that as
vFindText
vReplace
using Doug's code as find and replace?

 

[Greg Maxey]

Ann Marie,

I didn't test in Doug's code, but to use it in Find and Replace you
would do something like:

Sub FillArrayThenFindandReplace()
Dim myArray() As String
Dim oDoc As Word.Document
Dim i As Long
Dim j As Long
Dim pRow As Long
Dim oTbl As Word.Table
Dim oRng As Word.Range
Set oDoc = Documents.Open("C:\Word List.doc")
Set oTbl = oDoc.Tables(1)
ReDim myArray(oTbl.Rows.Count - 2, 1) 'Size the array
For pRow = 2 To oTbl.Rows.Count 'Start with 2 to skip the header row
For i = 1 To 2
myArray(pRow - 2, i - 1) = Left(oTbl.Cell(pRow, i), _
Len(oTbl.Cell(pRow, i).Range.Text) - 2)
Next
Next
oDoc.Close
Set oRng = ActiveDocument.Range
For pRow = 0 To UBound(myArray)
With oRng.Find
.Text = myArray(pRow, 0)
.Replacement.Text = myArray(pRow, 1)
.Execute Replace:=wdReplaceAll
End With
Next
End Sub

I have posted an Addin on my website that I created with the help of
Doug and others that you might be interested in:

http://gregmaxey.mvps.org/VBA_Find_And_Replace.htm

 

[Ann Marie]

Yes I have your add-in Greg - it is really super. I have lots of your
add-ins.

But I needed to set up a specific code routine for a group of templates.
Most grateful for the help from yourself and Doug - I just would not have
got nearly this far in such a short time.

Will put this code to good use. Add my extra find and replace routines and a
bit more testing and wallah!!

Ann

 

[Ann Marie]

Hi Greg,

I thought you might like to know that I also use Beta 2 2007 but for some
reason (beyond me) I cannot see your add-in in ADD-INS (VBA Find and
Replace - very cool) ribbon.

I use it in 2003 and it is fine - so it should load as my other add-ins do
when I load 2007 Word. It says it is loaded but it does not show in Ribbon
in ADD-INS?

Any ideas why that might be happening? I could move the code across I guess
and add to my global template - may be that will help.

Off to give this code a whirl and get this routine into test mode with my
templates in 2003.

Again, a huge thank you - they have "speed reading" and now "speed vba" with
the help of yourself Greg and Doug.

Enjoy your day ....

 

[Ann Marie]

Just did test Greg- it flys. The array is so quick. Really, thank you both.

I have a small issue with returns on a couple of arrays but arrays are not
meant to have carriage returns (as far as I am aware) so will work around
it.

Ann

 

[Laron Miyashiro]

wow

Hi Greg,

I thought you might like to know that I also use Beta 2 2007 but for some
reason (beyond me) I cannot see your add-in in ADD-INS (VBA Find and
Replace - very cool) ribbon.

I use it in 2003 and it is fine - so it should load as my other add-ins do
when I load 2007 Word. It says it is loaded but it does not show in Ribbon
in ADD-INS?

Any ideas why that might be happening? I could move the code across I guess
and add to my global template - may be that will help.

Off to give this code a whirl and get this routine into test mode with my
templates in 2003.

Again, a huge thank you - they have "speed reading" and now "speed vba" with
the help of yourself Greg and Doug.

Enjoy your day ....

 

[Greg Maxey]

Ann Marie,
I get "VBA Find and Replace User Interface" in the "Custom Toolbar" group of
the Addin Ribbon whenever I load the VBA Addin using Word2007 BETA 2.

I don't know why it won't work for you.