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