Code: Select all
Sub ReduceSpaces()
With Selection
.HomeKey Unit:=wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Text = "([A-Z])(.)( )"
.Replacement.Text = "\1\2 "
.Execute Replace:=wdReplaceAll
End With
End With
End Sub