Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
Set Rng = Selection.Range
With Rng
  .PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
  With .Duplicate
    .End = .Paragraphs.First.Range.End
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Text = "[“”\(\[\)\]]"
      .Replacement.Text = ""
      .Execute Replace:=wdReplaceAll
      .Text = Chr(34)
      .Replacement.Text = """"
      .Execute Replace:=wdReplaceAll
      .Text = ". . ."
      .Replacement.Text = "…"
      .Execute Replace:=wdReplaceAll
      .Text = "^s"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
      .Text = "[ ]{2,}"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
      .Text = "[^l^13]{1,}"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
    End With
  End With
  If MsgBox("Swap Citation & Reference?", vbYesNo) = vbYes Then
    With .Find
      .Text = "(*)^13(*^13)"
      .Replacement.Text = "\2(\1)^p"
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
    End With
  End If
  .Paragraphs.First.Range.Characters.Last = "  "
  .Start = .Paragraphs.First.Range.End
  .Select
End With
Application.ScreenUpdating = True
End Sub