Sub ChangeColor()
Dim StrColor
StrColor = InputBox("Please choose a colour (by number):" & vbCr & _
  vbTab & "Auto" & vbTab & vbTab & "0" & vbCr & _
  vbTab & "Black" & vbTab & vbTab & "1" & vbCr & _
  vbTab & "Blue" & vbTab & vbTab & "2" & vbCr & _
  vbTab & "BrightGreen" & vbTab & "4" & vbCr & _
  vbTab & "DarkBlue" & vbTab & vbTab & "9" & vbCr & _
  vbTab & "DarkRed" & vbTab & vbTab & "13" & vbCr & _
  vbTab & "DarkYellow" & vbTab & "14" & vbCr & _
  vbTab & "Gray25" & vbTab & vbTab & "16" & vbCr & _
  vbTab & "Gray50" & vbTab & vbTab & "15" & vbCr & _
  vbTab & "Green" & vbTab & vbTab & "11" & vbCr & _
  vbTab & "Pink" & vbTab & vbTab & "5" & vbCr & _
  vbTab & "Red" & vbTab & vbTab & "6" & vbCr & _
  vbTab & "Teal" & vbTab & vbTab & "10" & vbCr & _
  vbTab & "Turquoise" & vbTab & "3" & vbCr & _
  vbTab & "Violet" & vbTab & vbTab & "12" & vbCr & _
  vbTab & "White" & vbTab & vbTab & "8" & vbCr & _
  vbTab & "Yellow" & vbTab & vbTab & "7", "Colour Picker", 0)
With Selection.Find
  .ClearFormatting
  .Text = ""
  .Highlight = True
  .Replacement.Text = ""
  .Replacement.Font.ColorIndex = StrColor
  .Replacement.Highlight = False
  .Forward = True
  .Wrap = wdFindContinue
  .Execute Replace:=wdReplaceOne
End With
End Sub