Mass find and replace

[Bob]

I have to do multiple find and replaces in a word document. I have all the
information I need to find and what I need to replace it with in an excel
file. I would like to know if there is some type of software where I can do
multiple find and replaces and just copy the data from excel and paste it
into word and have it run the find and replace on several items. I have
looked for programs online, but have not had any luck. If anybody could help
me out I would really appreciate it.

 

[Sheeloo]

Open the Word file you want to work with...
Press ALT-F11 to open VB Editor
Insert a Module
Paste the code below in the module window
[Read through the code and follow instructions]
Press F5 to run the code (it will run on the current document)

Sub OpenAndReadExcelWB()
' to test this code, paste it into a module in the document
' you want to find and replace
' ADD a reference to the Excel-library
' Tools|Refernce and choose MS Excel Object Libray in VB Editor
' Create an Excel file having the word to replace in Col A
' and the word to replace it with in Col B
' save and close the file and update its name and path in the line which
has
' Set xlWB = xlApp.Workbooks.Open("C:\Book1.xls")

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim tString As String, r As Long
Dim rString As String
Set xlApp = CreateObject("Excel.Application")
'xlApp.Visible = True
'xlApp.ScreenUpdating = False
Set xlWB = xlApp.Workbooks.Open("C:\Book1.xls")
' open an existing workbook
r = 1
With xlWB.Worksheets(1)
While Cells(r, 1).Formula <> ""
tString = Cells(r, 1).Formula
rString = Cells(r, 2).Formula
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = tString
.Replacement.Text = rString
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
r = r + 1
Wend
End With
xlWB.Close False ' close the workbook without saving
xlApp.Quit ' close the Excel application
Set xlWB = Nothing
Set xlApp = Nothing
End Sub