Once doesn't necessarily want to have only single spaces after abbreviations like 'etc.', since that (and others) actually sometimes conclude a sentence. Your Find/Replace could also be greatly simplified via the use of wildcards - and without creating three spaces where there are now two. For example:
Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
'First, clear out all existing double, triple, etc. spaces
.Text = "[ ]{2,}"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
'Second, insert double spaces after every punctuation mark followed by a space then an upper-case letter
.Text = "([.\?\!\:\;] )([A-Z])"
.Replacement.Text = "\1 \2"
.Execute Replace:=wdReplaceAll
'Third, clean up common abbreviations
.Text = "([DMS][rs]{1,2}. ) ([A-Z])"
.Replacement.Text = "\1\2"
.Execute Replace:=wdReplaceAll
.Text = "(etc. ) ([a-z])"
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub
PS: When posting code, please use formatted code and the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.