Sub SwapWords()
' Paul Beverley - Version 07.06.22
' Swaps adjacent words

Selection.Expand wdWord
Selection.Cut
Selection.MoveRight wdWord, 1
Selection.MoveStart , -1
ch = Asc(Selection)
Selection.Collapse wdCollapseEnd
If ch = 32 Then
  Selection.Paste
Else
  Selection.TypeText Text:=" "
  Selection.Paste
  ch = Right(Selection, 1)
  Selection.MoveStart , -1
  Selection.Delete
End If
End Sub