Sub InitialSwapper()
' Paul Beverley - Version 06.06.22
' Swaps initials and surname (P.E. Beverley -> Beverley, P.E.)

' Expand selection to single or whole words
myStart = Selection.Start - 1
Selection.Collapse wdCollapseEnd
Selection.MoveLeft , 1
Selection.Expand wdWord
Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
  Selection.MoveEnd , -1
  DoEvents
Loop
Selection.Start = myStart
Selection.MoveStart wdWord, -1

Set rng = Selection.Range.Duplicate
rng.Collapse wdCollapseStart
With rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "[A-Z.^32\-]{1,}"
  .Forward = False
  .MatchWildcards = True
  .Execute
  DoEvents
End With

If Left(rng.Text, 1) = " " Then rng.MoveStart , 1
rng.Cut
Selection.Collapse wdCollapseEnd
Selection.MoveEnd , 1
If Selection = "," Then
  Selection.Collapse wdCollapseEnd
Else
  Selection.Collapse wdCollapseStart
  Selection.TypeText Text:=","
End If
Selection.TypeText Text:=" "
Selection.Paste
Set rng = Selection.Range.Duplicate
rng.MoveStart , -1
rng.MoveEnd , 1
If rng.Text = "  " Then rng.Text = " "

' Dummy find to reset the Find parameters
With rng.Find
  .Text = " "
  .Forward = True
  .Replacement.Text = ""
  .MatchWildcards = False
  .Execute
  DoEvents
End With
End Sub