View Single Post
 
Old 01-10-2024, 05:46 PM
syl3786 syl3786 is offline Windows 10 Office 2019
Advanced Beginner
 
Join Date: Jan 2023
Posts: 97
syl3786 is on a distinguished road
Default

Quote:
Originally Posted by Guessed View Post
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!
Reply With Quote