Sub SubscriptPara()
    Selection.HomeKey Unit:=wdStory, Extend:=wdMove
    Dim a As String
    With Selection.find
        .ClearFormatting
        .Replacement.ClearFormatting
        With .Replacement.font
            .Bold = True
            .Color = vbBlack
            .Superscript = True
            .Size = 10
        End With
        
        .Text = "[0-9]{1,} "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .format = True
        .MatchWildcards = True
    Do While .Execute = True
        a = MsgBox("Do you want the selection to be subscriptted?", vbYesNoCancel)
        If a = vbYes Then
            .Execute Replace:=wdReplaceOne
        ElseIf a = vbNo Then
            .Execute
        Else
            Exit Sub
        End If
    Loop
    End With
End Sub