How to create subset of unique items from array

I'm looking for some advice on the optimal method for identifying and grouping array elements. The array contains three elements as follows:

Code:

---

Option Base 1
Dim myArray(3, 10) as String
myArray(1,1) = "ABC Co"
myArray(2,1) = "123456"
myArray(3,1) = "Beans"
myArray(1,2) = "ABC Co"
myArray(2,2) = "234567"
myArray(3,2) = "Carrots"
myArray(1,3) = "ABC Co"
myArray(2,3) = "345678"
myArray(3,3) = "Lettuce"
myArray(1,4) = "XYZ Co"
myArray(2,4) = "456789"
myArray(3,4) = "Mustard"
myArray(1,5) = "XZY Co"
myArray(2,5) = "567890"
myArray(3,5) = "Beef"
myArray(1,6) = "123 Co"
myArray(2,6) = "678901"
myArray(3,6) = "Ice Cream"
myArray(1,7) = "456 Co"
myArray(2,7) = "789012"
myArray(3,7) = "Bread"
myArray(1,8) = "456 Co"
myArray(2,8) = "890123"
myArray(3,8) = "Lemonade"
myArray(1,9) = "789 Co"
myArray(2,9) = "901234"
myArray(3,9) = "Plates"
myArray(1,10) = "654 Co"
myArray(2,10) = "012345"
myArray(3,10) = "Cups"

---

There are two issues:

1. The array contains duplicate entries of the first element - myArray(1,x). I need to populate a combo box containing unique items only from this element - no duplicates. Is a simple comparison the best approach? Or is there a built-in VBA function that will return unique items?

2. Once the user selects an item from the combo box, I need to populate a list box with all the elements myArray(2,x) and myArray(3,x) where myArray(1,x) equals the user's selection. Again, is a simple comparison the best way?

Thanks for any advice or suggestions.

Cheers,
James

A fast way, depending on the size would be to dump the values into cells in a worksheet. Use countif the check each item against the whole. Clear the array, then refill only the values that are unique (based on the countif check).

Hi James,

A common approach here is to use a collection to effectively filter-out any duplicates. Something like this:

Code:

---

Option Base 1

Sub Test()
    Dim myArray(3, 10) As String, lDim1 As Long, lDim2 As Long
    Dim colUnique As New Collection, lCnt As Long
myArray(1, 1) = "ABC Co"
    myArray(2, 1) = "123456"
    myArray(3, 1) = "Beans"
    myArray(1, 2) = "ABC Co"
    myArray(2, 2) = "234567"
    myArray(3, 2) = "Carrots"
    myArray(1, 3) = "ABC Co"
    myArray(2, 3) = "345678"
    myArray(3, 3) = "Lettuce"
    myArray(1, 4) = "XYZ Co"
    myArray(2, 4) = "456789"
    myArray(3, 4) = "Mustard"
    myArray(1, 5) = "XZY Co"
    myArray(2, 5) = "567890"
    myArray(3, 5) = "Beef"
    myArray(1, 6) = "123 Co"
    myArray(2, 6) = "678901"
    myArray(3, 6) = "Ice Cream"
    myArray(1, 7) = "456 Co"
    myArray(2, 7) = "789012"
    myArray(3, 7) = "Bread"
    myArray(1, 8) = "456 Co"
    myArray(2, 8) = "890123"
    myArray(3, 8) = "Lemonade"
    myArray(1, 9) = "789 Co"
    myArray(2, 9) = "901234"
    myArray(3, 9) = "Plates"
    myArray(1, 10) = "654 Co"
    myArray(2, 10) = "012345"
    myArray(3, 10) = "Cups"
lDim1 = 1
    'look at first element entries only
On Error Resume Next
    For lDim2 = 1 To 10
    colUnique.Add myArray(lDim1, lDim2), CStr(myArray(lDim1, lDim2))
    Next lDim2
    On Error GoTo 0
    'add items to collection (can't accept duplicates)
For lCnt = 1 To colUnique.Count
    MsgBox colUnique(lCnt)
    Next lCnt
    'show unique items
End Sub

---

An alternative, building on Jacob's suggestion, would be to copy the data to a worksheet and use the Advanced Filter with the 'Unique' option. If there is a large amount of data and speed is an issue you may need to time the various approaches that you end up with and pick the most appropriate.

HTH

Hi guys,

I?m managed to escape from my rehab so here comes a total different approach to create a unique list and populate a combobox in a userform:

Code:

---

Option Explicit

Sub Unique_List()
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim i As Long, lnMode As Long
Dim vaData As Variant
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Blad1")
'Early binding but late binding would propably make it
'a little bit faster.
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stCon As String, stSQL As String
stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & wbBook.FullName & ";" & _
        "Extended Properties=""Excel 8.0;HDR=No"";"
'The keyword DISTINCT create a unique list.
stSQL = "SELECT DISTINCT * FROM [Blad1$A1:A10]"
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
cnt.Open stCon
rst.Open stSQL, cnt, adOpenForwardOnly, adLockReadOnly, adCmdText
With Application
    .ScreenUpdating = False
    lnMode = .Calculation
    .Calculation = xlCalculationManual
    Worksheets.Add Before:=wsSheet
    ActiveSheet.Cells(2, 1).CopyFromRecordset rst
    .Calculation = lnMode
    .ScreenUpdating = True
End With
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
vaData = ActiveSheet.UsedRange.Value
With UserForm1.ComboBox1
    .Clear
    .List = vaData
    .ListIndex = -1
End With
UserForm1.Show
End Sub

---

Since we in Excel has a large workspace to work with dumping data into a worksheet and then manipulate it is both a fast and a reliable way. The benefit will be higher the more data we handle.

Take care,
Dennis