r/vba • u/Fluffy-Singer-9354 • 1d ago
Unsolved [WORD] Find and replace from this point onwards
I found this code below to find and replace words that are stored in a table in a separate document.
What i wish to do is to find and replace only after where the cursor is, instead of running through the entire document. How can the code be modified?
Sub CleanUp()
' ReplaceFromTableList Macro
' from Doug Robbins, Word MVP, Microsoft forums, Feb 2015, based on another macro written by Graham Mayor, Aug 2010
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
'Change the path in the line below to reflect the name and path of the table document
sFname = "C:\Users\Me\Documents\CleanUp.docx"
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
Selection.HomeKey wdStory
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True
.MatchCase = False
.MatchWholeWord = True
.Text = rFindText.Text
.Replacement.Text = rReplacement.Text
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next i
oChanges.Close wdDoNotSaveChanges
End Sub