Microsoft Word - Find & Replace Font Color only works first time macro run

I need a macro that will replace the selected text font color from Black or Automatic to Blue font color (but not change the color if there is any is red colored text).
This code works well the first time it is run but if it is used again it changes the remainder of the document to blue font color.  Any help is appreciated.

Sub FindReplaceBlackToBlue()
   

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

    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorAutomatic
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorBlue
    With Selection.Find
      .Text = ""
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = True
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
    End With
    With Selection

      .Find.Execute Replace:=wdReplaceAll

End With

I tried this and it seemed to work for me, your cut adn paste left off and End Sub at the end but other than that it worked for me.

Don