View Single Post
 
Old 03-02-2020, 10:09 AM
kilroy kilroy is offline Windows 10 Office 2016
Competent Performer
 
Join Date: Sep 2016
Location: Southern Ontario
Posts: 118
kilroy is on a distinguished road
Default

All of my documents use default font color of black. So if you se other colors it may not work properly. I used 450 pages (2800 paragraphs) of the following example:

Each paragraph had either a . or an ! or a ? at he end of what we view as sentences.

"There is no Ms. simple programming solution for this? Although VBA has a'sentences' collection, that has no correlation with grammatical sentences? Forexample, consider the following: Mr. Smith spent $1,234.56 at Dr. John'sGrocery Store, to buy: 10.25kg of potatoes; 10kg of avocados; and 15.1kg of Mrs.Green's Mt. Pleasant macadamia nuts? For ETC. you and me, that would countas one sentence; for etc. VBA it counts as 5 sentences? "

It took around 2 minutes 40 seconds
(Code tags not working)

This works for me:
for some reason the lines with .Replacement.Text = "? " are removing the extra space it should have 2 spaces after the punctuation in all 3 scenarios.

Sub DoubleSpaceToEndSentence()
' Kilroy
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("Mr.", "Mrs.", "Ms.", "etc.", "ETC.", "Dr.", "Mt.", "[0-9].[0-9]")
For ii = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(ii)
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.Font.Color = vbBlue
Loop
End With
Next
Selection.Find.ClearFormatting
Selection.Find.Font.Color = Default
With Selection.Find
.Wrap = wdFindContinue
.MatchWildcards = False
.Text = ". "
.Replacement.Text = ". "
.Execute Replace:=wdReplaceAll
.Text = "! "
.Replacement.Text = "! "
.Execute Replace:=wdReplaceAll
.Text = "? "
.Replacement.Text = "? "
.Execute Replace:=wdReplaceAll
End With
Selection.WholeStory
With Selection
.Font.Color = Default
End With
End Sub
Reply With Quote