Word Macro issue: Change text color with track changes record

[syl3786]

Hello everyone,

I was hoping to get some assistance with an issue I'm having in a Word Document. I have a macro that changes text from wdred to wdblack, but I would like the changes to be tracked so that I can easily identify which parts of the document have been modified. I tried adding "ActiveDocument.TrackRevisions = True" at the beginning of the code, but unfortunately it's not working as expected. Although the text color is changing correctly, I'm unable to identify which parts of the document have been modified, as the document is quite large (200 pages).

Here's the code I'm currently using:

Sub Macro1()

    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorRed
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorBlack
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Would anyone be willing to assist with this issue? I would greatly appreciate any help or suggestions you may have. Thank you!


Remarks:

My computer:

Windows 10
Microsoft Office 2019
i7-8700
8 GB Ram

[vivka]

Hi! Try using

    ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions

[Charles Kenyon]

Cross-posted at:How to find all text in wdRed and then change to wdBlack, with track changes? - Eileen's Lounge
For cross-posting etiquette, please read: A Message to Forum Cross-Posters

[Guessed]

The Execute ReplaceAll command doesn't track the formatting change so you need to loop that step.

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

[syl3786]

Originally Posted by Guessed

The Execute ReplaceAll command doesn't track the formatting change so you need to loop that step.

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!

[perdur]

Sorry to jump into an old thread, but I tried out this solution and ran into a problem where the Word document is showing "simple" markup for the tracked changes (ie, just a line on the side of the text) even though it's in "All Markup" mode (which should be underlining the edited text). So it looks like this:

unnamed.png

The second and third lines were originally red. As you can see, they've successfully turned black, but they're not underlined the way tracked changes normally work. I've double-checked and confirmed that I'm in "All Markup" mode and not "Simple Markup," and I'm at a loss - does anyone know why the Simple Markup line is showing instead?

Despite my user settings, the computer I'm trying to do this on is running Windows 11 and using Office 365.

Edit: This was meant to be in response to the solution provided by Guessed:

Originally Posted by Guessed

The Execute ReplaceAll command doesn't track the formatting change so you need to loop that step.

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

[perdur]

Originally Posted by perdur

Sorry to jump into an old thread, but I tried out this solution and ran into a problem where the Word document is showing "simple" markup for the tracked changes (ie, just a line on the side of the text) even though it's in "All Markup" mode (which should be underlining the edited text).

Circling back to say that I did find a solution to this that shows the tracked changes as underlined instead of just a line on the side (part of the issue was that Word by default indicates font color changes with a line on the side instead of putting the text in tracked changes): Convert underline/strikethrough to Track Changes - Microsoft: Office | Tek-Tips

The solution from user macropod helped me get the text I wanted in tracked changes, so leaving this here in case anyone else stumbles upon this thread with the same issue!