Quote:
Originally Posted by vivka
Hi! This is the fastest way, otherwise you'll have to work with a range & then move it one char to the left in each loop:
Code:
With selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchWildcards = True
.text = Chr(9) & "1([!0-9])"
.Replacement.text = Chr(9) & "-\1"
.Execute Replace:=wdReplaceAll
.text = Chr(9) & "-"
.Replacement.text = ""
.Replacement.Font.ColorIndex = wdRed
.Execute Replace:=wdReplaceAll
End With
Notes: 1) there's no need for {1}; 2) Chr(9) can be used instead of vbTab, which I did; 3) Instead of 'selection.range.Find' you can use 'ActiveDocument.range.Find' & delete 'selection.HomeKey Unit:=wdStory, Extend:=wdMove' making the code shorter; 4) Tracking changes may be faulty (for an unknown reason, at least in my Word 2016), so disabling it can do no harm because the changes will be colored red & visible. Or you can color changes, say, blue if there are red strings in your doc. |
May I also ask about how to manipulate a range while shifting it one character to the left during each loop?
For example:
Code:
Sub test()
' Declare variables
Dim doc As Document
Dim xlApp As Object
Dim xlWbk As Object
Dim xlSht As Object
Dim rngFind As range
Dim rngReplace As range
Dim strFind As String
Dim strReplace As String
' Set the document object
Set doc = ActiveDocument
' Open the Excel workbook
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open("C:\Names.xlsx")
' Set the worksheet object
Set xlSht = xlWbk.Sheets(1)
' Loop through each row in the worksheet
For i = 1 To xlSht.UsedRange.Rows.Count
' Get the find and replace strings from the worksheet
strFind = xlSht.Cells(i, 1).Value
strReplace = xlSht.Cells(i, 2).Value
' Find and replace the text in the document
With doc.Content.Find
.ClearFormatting
.Text = strFind
.Replacement.ClearFormatting
.Replacement.Text = strReplace
' Set the font color to red
.Replacement.Font.Color = wdColorRed
' Find and replace while preserving the font color
.Format = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll, Format:=True
End With
Next i
' Close the Excel workbook
xlWbk.Close SaveChanges:=False
' Quit the Excel application
xlApp.Quit
This macro utilizes wildcards to replace text based on an Excel file. However, I am unsure how to modify it to shift one character to the left during each loop.
The macro needs to find "ABC (without Member)" (which is ABC[!Member] in wildcard), and replace as ABCMember.