PDA

View Full Version : How to create subset of unique items from array

jamescol
07-27-2004, 01:46 AM
I'm looking for some advice on the optimal method for identifying and grouping array elements. The array contains three elements as follows:

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(1,8) = "456 Co"
myArray(2,8) = "890123"
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

Jacob Hilderbrand
07-27-2004, 02:40 AM
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).

Richie(UK)
07-27-2004, 04:48 AM
Hi James,

A common approach here is to use a collection to effectively filter-out any duplicates. Something like this: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(1, 8) = "456 Co"
myArray(2, 8) = "890123"
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
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 SubAn 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

XL-Dennis
07-27-2004, 06:09 AM
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:

Option Explicit
Sub Unique_List()
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim i As Long, lnMode As Long
Set wbBook = ThisWorkbook

'Early binding but late binding would propably make it
'a little bit faster.
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]"
cnt.Open stCon

With Application
.ScreenUpdating = False
lnMode = .Calculation
.Calculation = xlCalculationManual
ActiveSheet.Cells(2, 1).CopyFromRecordset rst
.Calculation = lnMode
.ScreenUpdating = True
End With
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing