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(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

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(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 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
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