What you posted looks nothing like the solution I posted earlier.
Code:
Sub ChangeTrackBlueFont()
Dim oRng As Range
Selection.Find.ClearFormatting
Set oRng = ActiveDocument.Range
With oRng.Find
With .Font
.StrikeThrough = True
.DoubleStrikeThrough = False
.Color = wdColorBlue
End With
While .Execute
oRng.Delete
Wend
End With
ActiveDocument.TrackRevisions = False
Set oRng = ActiveDocument.Range
Selection.Find.ClearFormatting
With oRng.Find
With .Font
.Underline = wdUnderlineSingle
.Color = wdColorBlue
End With
While .Execute
With oRng.Font
.UnderlineColor = wdColorAutomatic
.Underline = wdUnderlineNone
End With
oRng.Cut
ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions
oRng.PasteAndFormat (wdFormatOriginalFormatting)
ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions
Wend
End With
lbl_Exit:
Exit Sub
End Sub