Sub TwoSpacesAfterSentence()

Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
  
    .ClearFormatting
    .MatchWildcards = True
    
    .Text = "(*{2})([.\!\?])([A-Z])"
    .Replacement.Text = "\1\2  \3" 'Two spaces between 2 and \
    .Execute Replace:=wdReplaceAll
    
    .Text = "(*{2})([.\!\?]) ([A-Z])"
    .Replacement.Text = "\1\2  \3" 'Two spaces between 2 and \
    .Execute Replace:=wdReplaceAll
    
    .Text = "([.\!\?]) {3,}([A-Z])"
    .Replacement.Text = "\1  \2"
    .Execute Replace:=wdReplaceAll
    
    'This should prevent most cases of improper double spacing
    'in names (e.g., F. Lee Bailey, George W. Bush, etc.)
    .Text = "([!A-Z][A-Z].)  ([A-Z])" 'Two spaces between ) and (
    .Replacement.Text = "\1 \2"
    .Execute Replace:=wdReplaceAll
    
  End With
lbl_exit:
  Exit Sub
End Sub