Find&Replace Macro is too slow
Hi all,
I am using this Find & Replace macro which replaces words in a document, by getting the replacement words from another document. This macro works great on documents with 1-2 pages, but crashes the document if it is more than that. I'd like to use this on word documents with 15-20 pages (and possibly with a lot of replacements).
Is there a way to slow down the macro, maybe run it in bits and pieces, or edit the code such that it doesn't crash?
Any advice is appreciated! Thanks in advance.
Code:
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 y As Integer
Dim sFname As String
Dim sAsk As String
sFname = "/Users/user/Desktop/testt.docx"
Set oDoc = ActiveDocument
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
Set oTable = oChanges.Tables(1)
y = 0
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
For Each oRng In oDoc.StoryRanges
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:=rFindText, _
MatchWholeWord:=True, _
MatchWildcards:=False, _
Forward:=True, _
Wrap:=wdFindStop) = True
oRng.FormattedText = rReplacement.FormattedText
y = y + 1
Loop
End With
Next oRng
Next i
oChanges.Close wdDoNotSaveChanges
MsgBox (y & " errors fixed")
End Sub
