Sub DeleteFootnoteNumbers()
Dim x As Long
With Selection.Find
  .ClearFormatting
  .Font.Color = wdColorRed
  .Replacement.ClearFormatting
  .Text = "^2 "
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  Do While .Execute(Replace:=wdReplaceOne)
    x = x + 1
  Loop
End With
MsgBox "Replaced: " & x
End Sub