genja,
Well obviously I failed to do exhaustive testing
My point was to try to convey that there is little point in evaluating every paragraph against the next. For Example if Leo Tolstoy would have inadvertently left a couple of empty paragraphs in War and Peace, why evaluate the whole book.
First find any instance where two or more paragraphs appear, then evaluate if the condition warrants removing them. I also failed it include the very issue you first posted about!
Anyway. Let's try again. Again the testing is not exhaustive but here at least the code is doing better. As for your error on .Text = Chr(13) & "{2,} ... that may be due to your regional settings "," may not be your defined list separator.
Code:
Sub DeleteEmptyParagraphs()
Dim oRng As Range, oRngEval As Range
Dim lngST As Long, lngCount As Long
Dim oPar As Paragraph
lngST = Timer
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = Chr(13) & "{2,}"
.MatchWildcards = True
While .Execute
Set oRngEval = oRng.Duplicate
Set oPar = oRngEval.Paragraphs(1)
Do While Not oPar Is Nothing
oPar.Range.Select
Select Case True
Case Len(oPar.Range.Text) = 1
Select Case True
Case oPar.Range.End = ActiveDocument.Range.End
oPar.Range.Delete
lngCount = lngCount + 1
Case oPar.Range.Text = ChrW(12) Or oPar.Range.Characters.Last.Next = ChrW(12)
Set oPar = oPar.Next
Case Else
oPar.Range.Delete
lngCount = lngCount + 1
End Select
Case Else
Set oPar = oPar.Next
End Select
Loop
oRng.Collapse wdCollapseEnd
Wend
End With
MsgBox "Paragraphs deleted: " & lngCount & " | Execution time: " & _
Round(Timer - lngST, 2) & " s | " & Format((Timer - lngST) / 60, "0.00") & " min"
lbl_Exit:
Exit Sub
End Sub