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

Article contributed by Bill Coan

Dim AmountMoved As Long

'select first two paragraphs
Selection.HomeKey unit:=wdStory
Selection.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdExtend
AmountMoved = Selection.MoveDown(unit:=wdParagraph, Count:=1,
Extend:=wdExtend)

'loop until no more paragraphs to move down to

Do While AmountMoved > 0

   If Selection.Paragraphs(1).Range.Text = Selection.Paragraphs(2).Range.Text Then
   Selection.Paragraphs(2).Range.Delete
   AmountMoved = Selection.MoveDown(unit:=wdParagraph, Count:=1, Extend:=wdExtend)
   Else
   AmountMoved = Selection.MoveDown(unit:=wdParagraph, Count:=1, Extend:=wdExtend)
   Selection.MoveStart unit:=wdParagraph, Count:=1
   End If

Loop

'Return to top of doc
Selection.HomeKey unit:=wdStory


Click to view Terms of Use page

Click to view Disclaimer page