Sub HardSpaceAfterSuperscriptNumbers()
' Paul Beverley - Version 17.11.22
' Switches space to hard space after all superscripted number

addHighlight = True
myColour = wdBrightGreen

Set rng = ActiveDocument.Content
With rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "[0-9][ ^0160]"
  .Wrap = wdFindStop
  .Replacement.Text = ""
  .Forward = True
  .MatchWildcards = True
  .MatchWholeWord = False
  .Execute
End With

myCount = 0
Do While rng.Find.Found = True
  rng.MoveEnd , -1
  If rng.Font.Superscript = True Then
    myCount = myCount + 1
    rng.MoveStart , 1
    rng.MoveEnd , 1
    rng.Text = ChrW(160)
    rng.Font.Superscript = False
    If addHighlight = True Then rng.HighlightColorIndex = myColour
    If myCount Mod 20 = 0 Then rng.Select
    rng.Collapse wdCollapseEnd
  End If
  rng.MoveStart , 2
  rng.Find.Execute
  DoEvents
Loop
MsgBox "Changed spaces: " & myCount
End Sub