Sub AddPuncDemo4()
  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)
        sLastWord = .Words.Last.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]*" 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