Sub AddSuperscript()
Const strFind As String = "[a-z][0-9]{1,}>"
Dim orng As Range
    Set orng = ActiveDocument.Range
    With orng.Find
        Do While .Execute(FindText:=strFind, MatchWildcards:=True)
            orng.Start = orng.Start + 1
            orng.Select: DoEvents
            If MsgBox("Replace " & orng.Text, vbYesNo) = vbYes Then
                orng.Font.Superscript = True
            End If
            orng.Collapse 0
        Loop
    End With
    Set orng = Nothing
End Sub