Sub NumberToTextCMOS()
' Paul Beverley - Version 29.08.22
' Converts next number into text, using e.g. "fourteen hundred"

oldFind = Selection.Find.Text
oldReplace = Selection.Find.Replacement.Text

' Find a number (six figures max)
Selection.End = Selection.Start
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "[0-9]{1,6}"
  .Forward = True
  .MatchWildcards = True
  .MatchWholeWord = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  .Execute
End With
startNum = Selection.Start
' Create a field containing the digits and a special format code
Selection.Fields.Add Range:=Selection.Range, _
   Type:=wdFieldEmpty, Text:="= " + Selection + " \* CardText", _
   PreserveFormatting:=True

' Select the field and copy it
Selection.MoveStart , -1
txt = Selection.Text
txt = Replace(txt, "-one thousand", "xzxz")
txt = Replace(txt, "one thousand one hundred", "eleven hundred")
txt = Replace(txt, "one thousand two hundred", "twelve hundred")
txt = Replace(txt, "one thousand three hundred", "thirteen hundred")
txt = Replace(txt, "one thousand four hundred", "fourteen hundred")
txt = Replace(txt, "one thousand five hundred", "fifteen hundred")
txt = Replace(txt, "one thousand six hundred", "sixteen hundred")
txt = Replace(txt, "one thousand seven hundred", "seventeen hundred")
txt = Replace(txt, "one thousand eight hundred", "eighteen hundred")
txt = Replace(txt, "one thousand nine hundred", "nineteen hundred")
txt = Replace(txt, "xzxz", "-one thousand")
Selection.Delete
Selection.InsertAfter Text:=txt
Selection.Cut
DoEvents

' Paste the text as unformatted, replacing the field
Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
   Placement:=wdInLine, DisplayAsIcon:=False

With Selection.Find
  .Text = oldFind
  .Replacement.Text = oldReplace
  .MatchWildcards = False
End With
Set rng = Selection.Range.Duplicate
rng.MoveStart , -1
ch1 = rng.Text
rng.MoveStart , 1
rng.MoveEnd , 1
ch2 = rng.Text
If (UCase(ch1) <> LCase(ch1)) And (UCase(ch2) <> LCase(ch2)) Then
  Selection.TypeText Text:=" "
End If
Set rng = ActiveDocument.Range(Start:=startNum - 1, End:=startNum)
If rng.Text <> " " Then rng.InsertBefore Text:=" "
End Sub