Consulting

Results 1 to 3 of 3

Thread: Find and delete duplicate word headings

  1. #1

    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

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

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

    Regards

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •