Sub FindNum()
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .ClearFormatting
    .Font.Superscript = False 'Don't find if already superscripted
    .Text = "[0-9]{1,} "
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchWildcards = True
    Do While .Execute
      oRng.Select
      Select Case MsgBox("Do you want the numbers found in the current paragraph to be subscripted?", vbYesNoCancel)
        Case vbYes
          SubscriptPara oRng.Paragraphs(1).Range
         Case vbNo
          oRng.End = oRng.Paragraphs(1).Range.End
        Case Else: Exit Sub
      End Select
      oRng.Collapse wdCollapseEnd
    Loop
  End With
lbl_Exit:
  Exit Sub
End Sub
Sub SubscriptPara(oRng As Range)
Dim oRngPar As Range
  Set oRngPar = oRng.Duplicate
  With oRng.Find
    .ClearFormatting
    .Font.Superscript = False 'Don't find if already superscripted
    .Text = "[0-9]{1,} "
    .MatchWildcards = True
     Do While .Execute
      If oRng.InRange(oRngPar) Then
        With oRng.Font
          .Bold = True
          .Color = vbBlack
          .Superscript = True
          .Size = 10
        End With
      Else
        Exit Do
      End If
      oRng.Collapse wdCollapseEnd
    Loop
  End With
lbl_Exit:
  Exit Sub
End Sub