Word Sort Remove Duplicate problems

[eduzs]

I have this macro which I get from Sorting Lists (Macro Methods)

I did some modifications.

I need a workaround to two problems:

1) If the selection includes the last paragraph of the document the code returns erro in the line "Set oPar2 = oPar1.Next" (opar2 = nothing).

2) If I select to do not remove duplicates (DelRep = 0) the code does not works and enters in infinite loop.

Thanks

Sub SortRemoveAndTrackDuplicates2()

Dim oPars As Paragraphs, oPar1 As Paragraph, oPar2 As Paragraph, oRng As Range, i As Long, NumOc As Integer, DelRep As Integer

Set oPars = Selection.Range.Paragraphs

If oPars.Count > 1 Then

    Selection.Sort SortOrder:=wdSortOrderAscending

Else

    MsgBox "Não há seleção válida para classificar!", vbCritical, " ERRO!"
    Exit Sub

End If

If Selection.Information(wdWithInTable) Then

    MsgBox "Please move items to sort from table.  You can move them back into" _
    & " a table after sorting."
    Exit Sub

End If

NumOc = IIf(MsgBox("Inserir número de ocorrências?", vbYesNo, "  NÚMERO DE OCORRÊNCIAS?") = vbYes, 1, 0)
DelRep = IIf(MsgBox("Remover itens duplicados?", vbYesNo, "  REMOVER DUPLICADAS?") = vbYes, 1, 0)

Set oPar1 = oPars.Item(1)

Do

    i = 1

    Do

        Set oPar2 = oPar1.Next

        If oPar2.Range.Text = oPar1.Range.Text Then

            i = i + 1
            If DelRep = 1 Then oPar2.Range.Delete

        Else

            Exit Do
        
        End If

    Loop

    Set oRng = oPar1.Range
    oRng.End = oRng.End - 1
    If NumOc = 1 Then oRng.InsertAfter " (" & CStr(i) & ")"

    If oPar1.Range.End = oPars.Last.Range.End Then Exit Do

    Set oPar1 = oPar2
    
Loop

End Sub

 

[Macropod]

Cross-posted at: Some problems in this script

Please read Mr Excel's policy on Cross-Posting in rule #13: http://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html

 

[eduzs]

I've found a solution myself.

For the 1st problem, I didn't found a solution, just stop the code if Selection.Range.Paragraphs.Count = ActiveDocument.Paragraphs.Count

If oPars.Count > 1 And Selection.Range.Paragraphs.Count < ActiveDocument.Paragraphs.Count Then
    Selection.Sort SortOrder:=wdSortOrderAscending
Else
    MsgBox "Não há seleção válida para classificar!", vbCritical, "  ERRO!"
    Exit Sub
End If

For the 2nd problem:

        If oPar2.Range.Text = oPar1.Range.Text Then
            i = i + 1
            If DelRep = 1 Then
                oPar2.Range.Delete
            Else
                Set oPar2 = oPar1.Next
                Exit Do
            End If
        Else
            Exit Do
        End If

Now I can I can now choose if I want numbering and/or exclude duplicates.

Thanks

 

[eduzs]

Cross-posted at: Some problems in this script

Please read Mr Excel's policy on Cross-Posting in rule #13: http://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html

Hi Macropod, is that possible to delete this thread? Thanks

 

[Macropod]

No, we don't just go about deleting threads.