Sub QuotesAddDouble() ' Paul Beverley - Version 08.12.22 ' Adds quotes round a word or phrase addHighlight = True myColour = wdBrightGreen ' doubles myOpen = ChrW(8220) myClose = ChrW(8221) If Selection = "." Then Selection.MoveLeft , 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 rng.Collapse wdCollapseEnd rng.InsertAfter Text:=myClose If addHighlight = True Then rng.HighlightColorIndex = myColour End If rng.Collapse wdCollapseEnd rng.Select End Sub