Sub DPU_Test2()
  'Application.ScreenUpdating = False
  Dim Para As Paragraph, oRng As Range
  Set oRng = ActiveDocument.Range
    With oRng.Find
      .Text = ".^p"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
      End With
  On Error Resume Next
  For Each Para In ActiveDocument.Paragraphs
    With Para.Range
      If Len(.Text) > 2 Then
        If Not .Characters.Last.Previous Like "[.!?:;]" Then
          Select Case .Words.Last.Previous.Words(1)
            Case "and", "but", "or"
              'do nothing
            Case Else
              .Characters.Last.InsertBefore ";"
          End Select
        End If
      End If
    End With
  Next
  'Application.ScreenUpdating = True
End Sub