Consulting

Results 1 to 4 of 4

Thread: How to create subset of unique items from array

  1. #1
    VBAX Tutor jamescol's Avatar
    Joined
    May 2004
    Location
    Charlotte, NC
    Posts
    251
    Location

    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:

    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
    "All that's necessary for evil to triumph is for good men to do nothing."

  2. #2
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    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).

  3. #3
    VBAX Contributor Richie(UK)'s Avatar
    Joined
    May 2004
    Location
    UK
    Posts
    188
    Location
    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 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

  4. #4
    VBAX Mentor XL-Dennis's Avatar
    Joined
    May 2004
    Location
    ?stersund, Sweden
    Posts
    499
    Location
    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
    Kind regards,
    Dennis

    ExcelKB | .NET & Excel | 2nd edition PED


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •