Sub AddQuotesDouble()
' Paul Beverley - Version 14.01.21
' Adds quotes round a word or phrase

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

myStart = Selection.Start
Selection.Collapse wdCollapseEnd
Selection.Expand wdWord
Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
  Selection.MoveEnd , -1
  DoEvents
Loop
Selection.Collapse wdCollapseEnd
Selection.TypeText myClose
Selection.End = myStart
Selection.Expand wdWord
Selection.Collapse wdCollapseStart
Selection.TypeText myOpen
End Sub