Sub QuotesAddDouble()
' Paul Beverley - Version 06.07.24
' Adds quotes round a word or phrase


useUSpunctuation = True

addHighlight = False
myColour = wdBrightGreen

' doubles
myOpen = ChrW(8220)
myClose = ChrW(8221)

' Or singles
' myOpen = ChrW(8216)
' myClose = ChrW(8217)

If Selection = "." Then Selection.MoveLeft , 1
Set rng = Selection.Range.Duplicate
rng.Collapse wdCollapseStart
rng.MoveStart , -1
If LCase(rng) = UCase(rng) Then Selection.MoveRight , 1
Set rng = Selection.Range.Duplicate
myEnd = rng.End
rng.Collapse wdCollapseStart
rng.Expand wdWord
rng.Collapse wdCollapseStart
rng.InsertBefore Text:=myOpen
If addHighlight = True Then
  rng.HighlightColorIndex = myColour
End If
rng.start = myEnd
rng.Expand wdWord
Do While InStr(ChrW(8217) & "' ", Right(rng.Text, 1)) > 0
  rng.MoveEnd , -1
  DoEvents
Loop
If useUSpunctuation = True Then
  rng.MoveEnd , 1
  If InStr(",.", Right(rng.Text, 1)) = 0 Then rng.MoveEnd , -1
End If

rng.Collapse wdCollapseEnd
rng.InsertAfter Text:=myClose
If addHighlight = True Then
  rng.HighlightColorIndex = myColour
End If
rng.Collapse wdCollapseEnd
rng.Select
End Sub