Sub AddPuncDemo3()
  Dim Para As Paragraph, oRng As Range, sLastWord As String, sFirstChar As String
  '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
      If .Information(wdInFieldResult) Or .Information(wdWithInTable) Or .Font.AllCaps Or .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
                .Characters.Last.InsertBefore ";" 'Insert semi colon if para starts lowercase
              End If
          End Select
        End If
      End If
    End With
NextFor:
  Next
  'Application.ScreenUpdating = True
End Sub