Try
Code:
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