How to replace multiple words with replacement words in Excel

[jvr]

How to replace multiple words with replacement words in Excel


In my Word documents, I must use temporary “Identifiers†(internal temporary
codes; supplied to me) that must be later replaced with actual “Identifiersâ€
(in an Excel file supplied by the customer much later and perhaps multiple
times).

The actual “Identifiers†in the Excel file are “paired†with my temporary
“Identifiers†(as two cells, side-by-side).

For example:
PTT-001 205-PTT-0924
PTT-124 205-PTT-0020
Meaning:
For each instance of PTT-001 replace with 205-PTT-0924,
for each instance of PTT-124 replace with 205-PTT-0020,
etc. (there may or may not be any particular pattern).

There will be hundreds of these “pairs†and each one may be in the document
zero, one, or more times.

Doing this manually with “Find and Replace†is extremely time-consuming.

Thanks so much in advance for any solution.

I really appreciate it.


(e-mail address removed)

 

[Graham Mayor]

If you copy the two columns of the Excel table to Word, and save it as a
Word document, with its path identified in place of "D:\My
Documents\Test\changes.doc" in the line:-

sFname = "D:\My Documents\Test\changes.doc"

the following macro run on your document will replace all the items in the
first column with the corresponding items in the second column

Sub ReplaceFromTableList()

Dim ChangeDoc As Document, RefDoc As Document
Dim cTable As Table
Dim oldPart As Range, newPart As Range
Dim i As Long
Dim sFname As String

sFname = "D:\My Documents\Test\changes.doc"
Set RefDoc = ActiveDocument
Set ChangeDoc = Documents.Open(sFname)
Set cTable = ChangeDoc.Tables(1)
RefDoc.Activate
For i = 1 To cTable.Rows.Count
Set oldPart = cTable.Cell(i, 1).Range
oldPart.End = oldPart.End - 1
Set newPart = cTable.Cell(i, 2).Range
newPart.End = newPart.End - 1
With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Execute findText:=oldPart, _
ReplaceWith:=newPart, _
Replace:=wdReplaceAll, _
MatchWholeWord:=True, _
MatchWildcards:=False, _
Forward:=True, _
Wrap:=wdFindContinue
End With
End With
Next i
ChangeDoc.Close wdDoNotSaveChanges
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>