Quote:
Originally Posted by Guessed
The Execute ReplaceAll command doesn't track the formatting change so you need to loop that step.
Code:
Sub Macro1()
Dim aRng As Range, aRng2 As Range
ActiveDocument.TrackRevisions = True
ActiveDocument.TrackFormatting = True
Set aRng = Selection.Range
Set aRng2 = aRng.Duplicate
With aRng.Find
.ClearFormatting
.Font.Color = wdColorRed
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute = True
aRng.Font.ColorIndex = wdBlack
aRng.End = aRng2.End
Loop
End With
End Sub
|
I want to express my deep gratitude for your assistance! The solution you provided has proven to be effective!