Sub delete_empty_paras()
 Dim doc As Document, para As Paragraph, paraNext As Paragraph, paraRng As Range, _
 paraLen As Integer, delCount As Integer, paraCount_pre As Integer, paraCount_post As Integer
     StartTime = Timer
    Set doc = ActiveDocument: Set para = doc.Paragraphs.First
    Do While Not para Is Nothing
        Set paraNext = para.Next
        If para.Range.Tables.count > 0 Then GoTo Skip
        Set paraRng = para.Range: paraLen = Len(para.Range.text)
        If paraRng.text = ChrW(12) Then GoTo Skip:If paraRng.text = "^m" Then GoTo Skip
        If paraLen <= 2 Then
            If Not ContainsBreaks(paraRng) And Not ContainsShapesOrImages(paraRng) Then
                paraCount_pre = doc.Paragraphs.count
                'paraRng.Select 'debugging
                paraRng.Delete: paraCount_post = doc.Paragraphs.count: del = IIf(paraCount_post <> paraCount_pre, 1, 0)
                delCount = delCount + del
            End If
        End If
Skip:
        Set para = paraNext
    Loop
     Debug.Print "Paragraphs deleted: " & delCount & "  |  Execution time: " &  _
                  Round(Timer - StartTime, 2) & " s  |  " & Format((Timer - StartTime) / 60, "0.00") & " min"
   End Sub

Function ContainsShapesOrImages(rng As Range) As Boolean
    Dim iLshp As InlineShape, shp As shape
    Dim found As Boolean
    found = False
    For Each iLshp In rng.InlineShapes 'check for InlineShapes
        found = True: Exit For
    Next iLshp
    If Not found Then 'check for regular shapes. do I even need this?
        For Each shp In rng.ShapeRange
            found = True: Exit For
        Next shp
    End If
    ContainsShapesOrImages = found
End Function

Function ContainsBreaks(rng As Range) As Boolean
     Dim searchText As Variant, found As Boolean, i As Integer
    searchText = Array("^b", "^m", "^12", "^n") 'checks for specific breaks
    found = False
    With rng.Find
        .ClearFormatting: .Forward = True: .Wrap = wdFindStop: .MatchWildcards = False
        For i = LBound(searchText) To UBound(searchText)
            .text = searchText(i)
            If .Execute Then: found = True: Exit For 'exit when found
        Next i
    End With
    ContainsBreaks = found
 End Function

 Function StopTimer(StartTime As Double) As Double
    Dim elapsedTime As Double
    elapsedTime = Timer - StartTime
    StopTimer = elapsedTime
End Function