Home > Software design >  Trying to Write a VBA Macro for Duplicated Paragraphs
Trying to Write a VBA Macro for Duplicated Paragraphs

Time:05-18

I'm trying to edit macro to identify duplicated paragraphs in a Word document. This code identifies the second instance quite well, but I'm trying to get it to highlight the first instance as well in a different color, but I can't manage it for the life of me.

Sub highdupParagraphs()
  Dim p As Paragraph
  Dim d As New Scripting.Dictionary
  Dim t As Variant
  Dim i As Integer
  Dim StartTime As Single

  StartTime = Timer

  ' collect duplicates


  For Each p In ActiveDocument.Paragraphs
    t = p.Range.Text
    If t <> vbCr Then
      If Not d.Exists(t) Then d.Add t, New Scripting.Dictionary
      d(t).Add d(t).Count   1, p
    End If
  Next

  ' highlight

 For Each t In d
    For i = 2 To d(t).Count
      d(t)(i).Range.HighlightColorIndex = wdPink
    Next
    
  Next


  Application.ScreenUpdating = True

  MsgBox "This code ran successfully in " & Round(Timer - StartTime, 2) & " seconds", vbInformation
End Sub

CodePudding user response:

In a single loop:

Sub highdupParagraphs()
    Dim p As Paragraph
    Dim d As New Scripting.Dictionary
    Dim t As Variant, StartTime As Single
    
    StartTime = Timer
    
    For Each p In ActiveDocument.Paragraphs
        t = p.Range.Text
        If t <> vbCr Then
            If Not d.Exists(t) Then
                d.Add t, p 'store the first instance
            Else
                If Not d(t) Is Nothing Then
                    'color first instance and unset it
                    d(t).Range.HighlightColorIndex = wdYellow
                    Set d(t) = Nothing
                End If
                p.Range.HighlightColorIndex = wdPink
            End If
        End If
    Next
    
    MsgBox "This code ran successfully in " & Round(Timer - StartTime, 2) & " seconds", vbInformation
End Sub
  • Related