Find and delete duplicate word headings

[mfizz]

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

[gmaxey]

Not well thought out but something like this:



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

[mfizz]

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

Regards