[need help] table with substitutions find & change

[wZrokowiec]

Hello,
Sunday and I'm at work ;-( I do a lot of "find & change" in Word
2003. Generally these are so-called "secretary mistakes" (for
instance: "[a space before comma or full stop, "house , garden" or no
space "home,garden, typing mistakes "generaly", "schoool", and many,
many others).

So far I've used a macro that changes it nice but .... the number of
entries is now so big that I have to divide one macro into several
smaller macros and this is a little bit (very?) annoying.

Is there an easier way to deal with it like for instance a macro that
opens a document (let's say c:/corrections.doc) and finds a string of
letters in one column of a table ("find") and substitutes it with a
strings of letters from the other column with the same row ("change
to"). The document (correction.doc) is composed of a table with only 2
columns but many rows that I consecutively fill with new entries. No
matter formatting and small/big letters.

Is it hard and time consuming to write such a macro?
Please.

wZrokowiec

 

[Graham Mayor]

That is fairly straightforward. Change the path where indicated to the two
column document containing the search terms in the first column and the
replacements in the second. http://www.gmayor.com/installing_macro.htm

Sub ReplaceFromTableList()
Dim oChanges As Document, oDoc As Document
Dim oTable As Table
Dim oRng As Range
Dim rFindText As Range, rReplacement As Range
Dim i As Long
Dim sFname As String
'*************************************
sFname = "D:\My Documents\Test\Changes.doc"
'*************************************
Set oDoc = ActiveDocument
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
Set oTable = oChanges.Tables(1)
For i = 1 To oTable.Rows.Count
Set oRng = oDoc.Range
Set rFindText = oTable.Cell(i, 1).Range
rFindText.End = rFindText.End - 1
Set rReplacement = oTable.Cell(i, 2).Range
rReplacement.End = rReplacement.End - 1
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:=rFindText, _
MatchWholeWord:=True, _
MatchWildcards:=False, _
Forward:=True, _
Wrap:=wdFindContinue) = True
oRng.Text = rReplacement
Loop
End With
Next i
oChanges.Close wdDoNotSaveChanges
End Sub

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


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

 

[wZrokowiec]

That is fairly straightforward>>

Thank you very much indeed. This saves me a lot of work.
Have a nice Sunday.

wZrokowiec

 

[Graham Mayor]

You are welcome

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


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