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