Subroutine erroneously removes remaining column data when removing duplicate rows

[WSanders2015]

I'm re-engineering a subroutine to remove the duplicate rows from a listbox; the "ColumnCount" property of the listbox is set to "13". If I don't call my duplicate removal subroutine, the listbox correctly contains all of the columns of data; however, several rows are dupliated. The subroutine is listed below:

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">[COLOR=#00008B]Private[/COLOR][COLOR=#00008B]Sub[/COLOR][COLOR=#000000] RemoveDuplicateListBoxRows[/COLOR][COLOR=#000000]()[/COLOR][COLOR=#000000]
    [/COLOR][COLOR=#00008B]Dim[/COLOR][COLOR=#000000] i [/COLOR][COLOR=#00008B]As[/COLOR][COLOR=#00008B]Long[/COLOR][COLOR=#000000],[/COLOR][COLOR=#000000] j [/COLOR][COLOR=#00008B]As[/COLOR][COLOR=#00008B]Long[/COLOR][COLOR=#000000]
    [/COLOR][COLOR=#00008B]Dim[/COLOR][COLOR=#000000] nodupes [/COLOR][COLOR=#00008B]As[/COLOR][COLOR=#00008B]New[/COLOR][COLOR=#000000] Collection
    [/COLOR][COLOR=#00008B]Dim[/COLOR][COLOR=#000000] Swap1[/COLOR][COLOR=#000000],[/COLOR][COLOR=#000000] Swap2[/COLOR][COLOR=#000000],[/COLOR][COLOR=#000000] Item

    [/COLOR][COLOR=#00008B]With[/COLOR][COLOR=#00008B]Me[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]lbSrchMatchingResults

        [/COLOR][COLOR=#00008B]For[/COLOR][COLOR=#000000] i [/COLOR][COLOR=#000000]=[/COLOR][COLOR=#800000]0[/COLOR][COLOR=#00008B]To[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]ListCount [/COLOR][COLOR=#000000]-[/COLOR][COLOR=#800000]1[/COLOR][COLOR=#000000]
            [/COLOR][COLOR=#808080]' The next statement ignores the error caused[/COLOR][COLOR=#000000]
            [/COLOR][COLOR=#808080]' by attempting to add a duplicate key to the collection.[/COLOR][COLOR=#000000]
            [/COLOR][COLOR=#808080]' The duplicate is not added - which is just what we want![/COLOR][COLOR=#000000]
            [/COLOR][COLOR=#00008B]On[/COLOR][COLOR=#00008B]Error[/COLOR][COLOR=#00008B]Resume[/COLOR][COLOR=#00008B]Next[/COLOR][COLOR=#000000]
            nodupes[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]Add [/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]List[/COLOR][COLOR=#000000]([/COLOR][COLOR=#000000]i[/COLOR][COLOR=#000000]),[/COLOR][COLOR=#00008B]CStr[/COLOR][COLOR=#000000](.[/COLOR][COLOR=#000000]List[/COLOR][COLOR=#000000]([/COLOR][COLOR=#000000]i[/COLOR][COLOR=#000000]))[/COLOR][COLOR=#000000]
        [/COLOR][COLOR=#00008B]Next[/COLOR][COLOR=#000000] i

    [/COLOR][COLOR=#808080]'   Resume normal error handling[/COLOR][COLOR=#000000]
        [/COLOR][COLOR=#00008B]On[/COLOR][COLOR=#00008B]Error[/COLOR][COLOR=#00008B]GoTo[/COLOR][COLOR=#800000]0[/COLOR][COLOR=#000000]

        [/COLOR][COLOR=#808080]'Clear the listbox[/COLOR][COLOR=#000000]
        [/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]Clear

        [/COLOR][COLOR=#808080]'Sort the collection (optional)[/COLOR][COLOR=#000000]
        [/COLOR][COLOR=#00008B]For[/COLOR][COLOR=#000000] i [/COLOR][COLOR=#000000]=[/COLOR][COLOR=#800000]1[/COLOR][COLOR=#00008B]To[/COLOR][COLOR=#000000] nodupes[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]Count [/COLOR][COLOR=#000000]-[/COLOR][COLOR=#800000]1[/COLOR][COLOR=#000000]
            [/COLOR][COLOR=#00008B]For[/COLOR][COLOR=#000000] j [/COLOR][COLOR=#000000]=[/COLOR][COLOR=#000000] i [/COLOR][COLOR=#000000]+[/COLOR][COLOR=#800000]1[/COLOR][COLOR=#00008B]To[/COLOR][COLOR=#000000] nodupes[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]Count
                [/COLOR][COLOR=#00008B]If[/COLOR][COLOR=#000000] nodupes[/COLOR][COLOR=#000000]([/COLOR][COLOR=#000000]i[/COLOR][COLOR=#000000])[/COLOR][COLOR=#000000]>[/COLOR][COLOR=#000000] nodupes[/COLOR][COLOR=#000000]([/COLOR][COLOR=#000000]j[/COLOR][COLOR=#000000])[/COLOR][COLOR=#00008B]Then[/COLOR][COLOR=#000000]
                    Swap1 [/COLOR][COLOR=#000000]=[/COLOR][COLOR=#000000] nodupes[/COLOR][COLOR=#000000]([/COLOR][COLOR=#000000]i[/COLOR][COLOR=#000000])[/COLOR][COLOR=#000000]
                    Swap2 [/COLOR][COLOR=#000000]=[/COLOR][COLOR=#000000] nodupes[/COLOR][COLOR=#000000]([/COLOR][COLOR=#000000]j[/COLOR][COLOR=#000000])[/COLOR][COLOR=#000000]
                    nodupes[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]Add Swap1[/COLOR][COLOR=#000000],[/COLOR][COLOR=#000000] before[/COLOR][COLOR=#000000]:=[/COLOR][COLOR=#000000]j
                    nodupes[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]Add Swap2[/COLOR][COLOR=#000000],[/COLOR][COLOR=#000000] before[/COLOR][COLOR=#000000]:=[/COLOR][COLOR=#000000]i
                    nodupes[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]Remove i [/COLOR][COLOR=#000000]+[/COLOR][COLOR=#800000]1[/COLOR][COLOR=#000000]
                    nodupes[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]Remove j [/COLOR][COLOR=#000000]+[/COLOR][COLOR=#800000]1[/COLOR][COLOR=#000000]
                [/COLOR][COLOR=#00008B]End[/COLOR][COLOR=#00008B]If[/COLOR][COLOR=#000000]
            [/COLOR][COLOR=#00008B]Next[/COLOR][COLOR=#000000] j
        [/COLOR][COLOR=#00008B]Next[/COLOR][COLOR=#000000] i

    [/COLOR][COLOR=#808080]'   Add the sorted and non-duplicated items to the ListBox[/COLOR][COLOR=#000000]
        [/COLOR][COLOR=#00008B]For[/COLOR][COLOR=#00008B]Each[/COLOR][COLOR=#000000] Item [/COLOR][COLOR=#00008B]In[/COLOR][COLOR=#000000] nodupes
            [/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]AddItem Item
        [/COLOR][COLOR=#00008B]Next[/COLOR][COLOR=#000000] Item

    [/COLOR][COLOR=#00008B]End[/COLOR][COLOR=#00008B]With[/COLOR][COLOR=#000000]
[/COLOR][COLOR=#00008B]End[/COLOR][COLOR=#00008B]Sub[/COLOR]</code>

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">The problem begins with the following line of code:

[COLOR=#00008B]<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">[COLOR=#000000]nodupes[/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]Add [/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]List[/COLOR][COLOR=#000000]([/COLOR][COLOR=#000000]i[/COLOR][COLOR=#000000]),[/COLOR][COLOR=#00008B]CStr[/COLOR][COLOR=#000000](.[/COLOR][COLOR=#000000]List[/COLOR][COLOR=#000000]([/COLOR][COLOR=#000000]i[/COLOR][COLOR=#000000]))
[/COLOR]</code>[/COLOR]

It's only adding the first column of my 13-column worksheet to the collection variable "nodupes". I would like to add an entire row from the worksheet to the sheet. How do I modify my collection to accept a complete row of data, not just the first cell of a row, such that listbox is properly reconstructed when the following code is executed?

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">[COLOR=#00008B]For[/COLOR][COLOR=#00008B]Each[/COLOR][COLOR=#000000] Item [/COLOR][COLOR=#00008B]In[/COLOR][COLOR=#000000] nodupes
      [/COLOR][COLOR=#000000].[/COLOR][COLOR=#000000]AddItem Item
 [/COLOR][COLOR=#00008B]Next[/COLOR][COLOR=#000000] Item[/COLOR]</code>

</code>

 

[Jerry Sullivan]

I'd recommend handling the data in a 2D Array. For the sort, that can be done more simply using a worksheet than through VBA.

If you'd like to pursue that approach, I can suggest some code.

 

[WSanders2015]

I'm close to a solution. I'm now getting a type mismatch. My updated code is listed below:

Private Sub RemoveDuplicateListBoxRows()
    Dim i As Long, j As Long, z As Long
    Dim NoDupes As New Collection
    'Dim Swap1, Swap2, Item
    
    With Me.lbSrchMatchingResults
    
        For i = 0 To .ListCount - 1
            ' The next statement ignores the error caused
            ' by attempting to add a duplicate key to the collection.
            ' The duplicate is not added - which is just what we want!
            On Error Resume Next
            'NoDupes.Add Array(.List(i, 0), .List(i, 1), .List(i, 2), .List(i, 3), .List(i, 4), .List(i, 5), .List(i, 6), .List(i, 7), .List(i, 8), .List(i, 9), .List(i, 10), .List(i, 11), .List(i, 12)), _
            '.List(i, 0) & "|" & .List(i, 1) & "|" & .List(i, 2) & "|" & .List(i, 3) & "|" & .List(i, 4) & "|" & .List(i, 5) & "|" & .List(i, 6) & "|" & .List(i, 7) & "|" & .List(i, 8) & "|" & .List(i, 9) & "|" & .List(i, 10) & "|" & .List(i, 11) & "|" & .List(i, 12)
        Next i
   
    '   Resume normal error handling
        On Error GoTo 0
    
        'Clear the listbox
        .Clear
    
    '   Add the sorted and non-duplicated items to the ListBox
        For Each Item In NoDupes
            .AddItem Item 'This line throws a type mismatch error
        Next Item
        
    End With
End Sub

Do you have any ideas on how to fix the type mismatch error?

Thanks

 

[Jerry Sullivan]

Do you consider rows that have the same item in the first column, but different items in the second-thirteenth column "duplicates"?

 

[WSanders2015]

This is what I have so far; see below:

'   Add the sorted and non-duplicated items to the ListBox
        For Each Item In NoDupes
            For z = 0 To NoDupes.Count
            .AddItem
            .List(z, 0) = Item(0) 'Contains a unique alpha-numeric identifier
            .List(z, 1) = Item(1)
            .List(z, 2) = Item(2)
            .List(z, 3) = Item(3)
            .List(z, 4) = Item(4)
            .List(z, 5) = Item(5)
            .List(z, 6) = Item(6)
            .List(z, 7) = Item(7)
            .List(z, 8) = Item(8)
            .List(z, 9) = Item(9)
            .List(z, 10) = Item(10)
            .List(z, 11) = Item(11)
            .List(z, 12) = Item(12)
            Next z
        Next Item

The problem with the above code is that I can't iterate to the next Item. There's a logic failure with the inner for-loop. When I execute "MsgBox TypeName(Item)", VBA returns a "Variant()"; when I execute "MsgBox TypeName(NoDupes)", it returns a "Collection". The variable "Item" is a two dimensional array. I need to be able to loop through it and sign each row to a listbox.

 

[Jerry Sullivan]

The easiest way to populate your multicolumn listbox is to pass a single 2D Array to the Listbox.List Property.

I can suggest some code, if you'll respond to my previous question.

 

[WSanders2015]

Q: Do you consider rows that have the same item in the first column, but different items in the second-thirteenth column "duplicates"?
A: This is not possible as the first column uniquely identifies a resource; the first column contains an alpha-numeric ID with the form "R<number>". The second column identifies the resource type, the third column identifies the name of the resource, the fourth column contains a textual description of the resource, the and so on. Each column of information uniquely describes the resource. A snapshot of the resource rows are listed below:
R1

 

[WSanders2015]

R1 Application ABC Application An application for tracking widgets ...... Eight more columns of info on a resource
R2 Document Report on Widgets A report on widgets ....... Eight more columns of info on a resource

 

[Jerry Sullivan]

Thanks that helps.

Try using a general purpose function to sort the listbox data and remove duplicates. Copy this function into a Standard Code Module (like Module1) in your Workbook.

Function SortAndRemoveDups(ByVal vInput As Variant, _
   ByVal bHasKey As Boolean) As Variant
 '--sorts 2D array based on first field
 '     then removes duplicates and returns variant result
 '--if bHasKey is True, removes duplicates based on first
 '     field only, else uses all fields.
 
 Dim i As Integer
 Dim lRows As Long, lCols As Long
 Dim vReturn As Variant, vDupColList As Variant
 Dim wsTemp As Worksheet
 
 lRows = UBound(vInput, 1) - LBound(vInput, 1) + 1
 lCols = UBound(vInput, 2) - LBound(vInput, 2) + 1
 
 Set wsTemp = ThisWorkbook.Worksheets.Add
 With wsTemp
   '--write values to temp worksheet
   .Cells(1).Resize(lRows, lCols).Value = vInput
   
   '--sort by first field
   With .Cells(1).Resize(lRows, lCols)
      .Sort Key1:=.Cells(1), _
      Order1:=xlAscending, _
      Header:=xlNo, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom
 
      '--remove duplicates
      If bHasKey Then
         .RemoveDuplicates Columns:=1, Header:=xlNo
      Else
         '--build array of column indicies
         ReDim vDupColList(0 To lCols - 1)
         For i = 0 To UBound(vDupColList)
            vDupColList(i) = i + 1
         Next i
         
         .RemoveDuplicates Columns:=(vDupColList), Header:=xlNo
      End If
   End With
   
   '--read sorted-no dups values into return array
   lRows = .Cells(.Rows.Count, "A").End(xlUp).Row
   vReturn = .Cells(1).Resize(lRows, lCols)
   
   '--delete temp sheet
   Application.DisplayAlerts = False
   .Delete
   Application.DisplayAlerts = True
 End With
 
 SortAndRemoveDups = vReturn
End Function

Then call the function from code like this associated with a button in your UserForm. This example assumes you have a button named "cmdSortAndRemoveDups"

Private Sub cmdSortAndRemoveDups_Click()
 Dim vData As Variant
 
 vData = Me.lbSrchMatchingResults.List
 
 '--call shared function to sort and remove duplicates
 vData = SortAndRemoveDups(vInput:=vData, bHasKey:=True)
 
 '--repopulate listbox
 Me.lbSrchMatchingResults.List = vData
 
End Sub

This call assumes your listbox was already populated through UserForm_Initialize or another procedure before the command button is enabled.

 

[WSanders2015]

My form is named "FSearchResources"; it contains a listbox named "lbSrchMatchingResults". How do I call "SortAndRemoveDups" on this listbox as your function takes two parameters, a variant and boolean?