Problem in removing the blank paragraphs

Lawlords
Lawlords used Ask the Experts™
on
Dear all,

I have written the code to remove the unnecessary blank paragraphs between the tables so as to keep a single paragraph between any 2 tables. However, there must be some logical errors in mycode causing the following problems:

1. Most of the unnecessary blank paragraphs were removed except 2 continues blank  paragraph remained
2. The code can't stop once initialzed

Thanks for any asstance in advance

Do

    Selection.find.ClearFormatting
    Selection.find.Replacement.ClearFormatting
    With Selection.find
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue 'wdFindAsk
    End With
    Selection.find.Execute Replace:=wdReplaceAll


Loop Until Selection.find.Found = False

Open in new window

Sample.doc
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Retired
Top Expert 2012
Commented:
There does seem to be a bug whereby the replacing the last pair of paragraphs between tables just does nothing, so the find always works.

This code finds two or more empty paragraphs and deletes all but the first one.
Sub DeleteParas()
    Dim rng As Range
    
    Set rng = ActiveDocument.Range
    With rng.Find
        .Text = "[^13]{2,}"
        .MatchWildcards = True
        Do
            If .Execute Then
                rng.MoveStart wdCharacter
                rng.Delete
                rng.End = ActiveDocument.Range.End
            Else
                Exit Do
            End If
        Loop
    End With
End Sub

Open in new window

Author

Commented:
Thanks very much GrahamSkan

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial