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