delete 1 or 2 adjacent duplicate paragraphs, macro

[moorea21]

I am hoping to be able to write a macro that deletes a paragraph if it follows a duplicate paragraph. I have written a macro to delete all the unwanted tags etc from an srt file, and just leave the subtitle's words. What generally happens is that the resulting files have 3 duplicate paragraphs in a row, but not exclusively. The subtitles are in Russian cyrillic, so none of the online srt to text converters want to know.
I re-wrote a macro I found on the net (always a bad start, I know) and surprise surprise, it doesnt work...


Sub DeleteDuplicateParagraphsInSRTsOnly()


Dim p1 As Paragraph
Dim p2 As Paragraph
Dim p3 As Paragraph


For Each p1 In ActiveDocument.Paragraphs
For Each p3 In ActiveDocument.Paragraphs
If p1.Range.Text = p3.Range.Text Then p3.Range.Delete
For Each p2 In ActiveDocument.Paragraphs
If p1.Range.Text = p2.Range.Text Then p2.Range.Delete
Next p1

End Sub


Obviously I don't know what I'm doing. I had hoped it would just read the 3rd paragraph, compare it to the first, delete if identical, then apply the same rule to the 2nd paragraph, then move on to the compare what was originally the 4th paragraph with the 7th, etc.


What am I miossing in order to get this to work?




Thanks

[Guessed]

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.

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

[macropod]

It's not exactly clear what you mean by:

deletes a paragraph if it follows a duplicate paragraph

If all you're wanting to do is delete consecutive duplicate paragraphs, you don't need a macro; it can be done via a wildcard Find/Replace, where:
Find = (*^13)\1
Replace = \1

[moorea21]

Hi Macropod,


I tried that, I don't know why, but it found no matches, even though the duplicates were all adjacent, and very visible to me...


Guessed:


This works great, except that it deletes all occurances of a paragraph, rather than just the adjacent ones. If the same paragraph is repeated further down the original srt file, it deletes that too, so the resuklting script doesn't make sense. Is there a way to limit it to onlt looking 2 paragraphs ahead, rather than trying to look for the target paragraph in the rest of the document?


I can't find a button to press to attach the txt file I've uploaded which I was working on



Thanks for the help, was floundering before.

[macropod]

Originally Posted by moorea21

I tried that, I don't know why, but it found no matches, even though the duplicates were all adjacent, and very visible to me...

Did you check the 'use wildcards' option?