Delete any paragraph that is an exact duplicate of the preceding paragraph, using a Range object

Article contributed by Bill Coan

Dim AmountMoved As Long
Dim myRange As Range

'start with first paragraph and extend range down to second
Set myRange = ActiveDocument.Paragraphs(1).Range
AmountMoved = myRange.MoveEnd(unit:=wdParagraph, Count:=1)

'loop until there are no more paragraphs to check

Do While AmountMoved > 0

    'if two paragraphs are identical, delete second one
    'and add the one after that to myRange so it can be checked

    If myRange.Paragraphs(1).Range.Text = _
            myRange.Paragraphs(2).Range.Text Then
        myRange.Paragraphs(2).Range.Delete
        AmountMoved = myRange.MoveEnd(unit:=wdParagraph, Count:=1)
    Else
        'if two paragraphs aren't identical, add the one after
        'that to my range, so it can be checked, and drop the first one,
        'since it is no longer of interest.
        AmountMoved = myRange.MoveEnd(unit:=wdParagraph, Count:=1)
        myRange.MoveStart unit:=wdParagraph, Count:=1
   End If

Loop


Click to view Terms of Use page

Click to view Disclaimer page