Find and delete duplicate word headings

I have a document with lots of Heading 1 Heading 2

I want to search all the Heading 1 and only keep the first instance of each e.g.

The document is laid out like this


Heading 1 - ABC

Heading 2 - xxx

Heading 1 - ABC

Heading 2 - xxy

Heading 1 - ABC

Heading 2 - xxz

Heading 1 - CBA

Heading 2 - xxx

There are 100s of instances like this, I want this to become like below:

Heading 1 - ABC

Heading 2 - xxx
Heading 2 - xxy
Heading 2 - xxz

Heading 1 - CAB

Heading 2 - xxx

So need to count the number of unique entries of heading 1's and only keep the first instance.

Thanks

Not well thought out but something like this:

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngIndex As Long
Dim oRng As Word.Range
Dim oCol As New Collection
  For lngIndex = 1 To ActiveDocument.Paragraphs.Count
    If ActiveDocument.Paragraphs(lngIndex).Range.Style = "Heading 1" Then
      On Error GoTo flag_Duplicate
      oCol.Add ActiveDocument.Paragraphs(lngIndex).Range, ActiveDocument.Paragraphs(lngIndex).Range
    End If
  Next lngIndex
  MsgBox "There are " & oCol.Count & " unique Heading 1"
  If MsgBox("Do you want to delete duplicates?", vbYesNo, "Delete Dups") = vbYes Then
    For lngIndex = ActiveDocument.Paragraphs.Count To 1 Step -1
      If VBA.Right(ActiveDocument.Paragraphs(lngIndex).Range.Text, 14) = " (Duplicated)" & vbCr Then
        ActiveDocument.Paragraphs(lngIndex).Range.Delete
      End If
    Next lngIndex
  End If
lbl_Exit:
  Exit Sub
flag_Duplicate:
  Set oRng = ActiveDocument.Paragraphs(lngIndex).Range
  oRng.MoveEnd wdCharacter, -1
  oRng.InsertAfter " (Duplicated)"
  Resume Next
End Sub

---

That seems like a better solution then my numerous for loops. Thanks.

Regards