delete 1 or 2 adjacent duplicate paragraphs, macro

Guessed · #2 10-31-2018, 05:03 PM

Looping through every subsequent paragraph is a very slow way to go about this. I would use a Find function which is way faster but has the drawback of not working with long paragraphs (I think the limit is 255 characters). I suspect the subtitles are generally short so this might not be a problem for you.

Code:

Sub DeleteDuplicates()
  Dim aRng As Range, aPara As Paragraph, sText As String
  Set aPara = ActiveDocument.Paragraphs.First
  Do While aPara.Range.End <> ActiveDocument.Range.End
    If Len(aPara.Range.Text) > 1 Then
      sText = aPara.Range.Text
      Debug.Print sText
      Set aRng = ActiveDocument.Range
      aRng.Start = aPara.Range.End
      With aRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = sText
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
      End With
    End If
    Set aPara = aPara.Next
  Loop
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro Needed to delete Unwanted paragraphs within a table.	frustrated teacher	Word VBA	0	06-05-2015 12:47 PM
How to delete the two non-adjacent rows in a table Word	beginner	Word	2	01-05-2015 05:47 AM
Macro Needed to delete Unwanted paragraphs in series	frustrated teacher	Word VBA	1	05-02-2014 03:32 PM
Macro to Delete Duplicate Rows and Retain Unique Value	expert4knowledge	Excel Programming	1	02-17-2014 08:02 PM
Word Macro to find and delete rows that contain adjacent cells containing "."	AlexanderJohnWilley	Word VBA	7	11-08-2012 10:15 AM