Word Sort Remove Duplicate problems

eduzs

Well-known Member
Joined
Jul 6, 2014
Messages
704
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
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

Code:
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
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
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

Code:
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:

Code:
        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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,267
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top