Does these modifications deal with those edge cases?
Code:
Sub AddPuncDemo5()
Dim Para As Paragraph, oRng As Range, sLastWord As String, sFirstChar As String, bListEnd As Boolean
'Application.ScreenUpdating = False
With ActiveDocument.Range.Find
.ClearFormatting
.Text = "^w^p"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
End With
For Each Para In ActiveDocument.Paragraphs
With Para.Range
.Select
If .Information(wdWithInTable) Or .Font.AllCaps Or .Characters.First.Font.Bold Or Len(.Text) < 3 Then
GoTo NextFor
Else
sFirstChar = .Characters(1)
If sFirstChar = "[" Or sFirstChar = "(" Then sFirstChar = .Characters(2)
sLastWord = .Words.Last.Previous.Words(1)
If sLastWord = "]" Or sLastWord = ")" Then sLastWord = .Words.Last.Previous.Previous.Words(1)
Debug.Print sFirstChar, sLastWord
If Not sLastWord Like "*[.!?:;]" Then 'If para ends with any of these characters do nothing
Select Case sLastWord
Case "and", "but", "or", "then", "plus", "minus", "less", "nor"
Set oRng = .Words.Last '.Previous.Words(1)
oRng.MoveStartUntil cSet:=" ", Count:=-10
Set oRng = oRng.Characters.First.Previous.Previous
oRng.Select
If oRng.Text = "," Then
oRng.Text = ";"
ElseIf oRng.Text Like "[a-z0-9)]*" Or oRng.Text = "]" Then
oRng.Collapse Direction:=wdCollapseEnd
oRng.Text = ";"
End If
Case Else
If sFirstChar = UCase(sFirstChar) Then
.Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
Else
If Para.Range.End < ActiveDocument.Range.End Then
bListEnd = Para.Range.ParagraphFormat.OutlineLevel > Para.Next.Range.ParagraphFormat.OutlineLevel
If bListEnd Then
.Characters.Last.InsertBefore "." 'Insert period if stepping up levels
Else
.Characters.Last.InsertBefore ";" 'Insert semi colon followed by same or lower level
End If
Else
.Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
End If
End If
End Select
End If
End If
End With
NextFor:
Next
'Application.ScreenUpdating = True
End Sub