Creating a List of Unique Values for a Combobox Rowsource

[Ark68]

Hello,

I am using the code below to take the values in column G (starting at G6) of worksheet "LISTS1" to create the rowsource for combobox "cb_league1" in my userform.

    With Worksheets("LISTS1")
        Set Rng = .Range("G6", .Range("G6").End(xlDown))
    End With
    For Each cell In Rng.Cells
        With Me.cb_league1
            .AddItem cell.Value
            .List(.ListCount - 1, 1) = cell.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = cell.Offset(0, 2).Value
        End With
    Next cell

It works, but I would like to enhance it (if possible) to use only unique values in the rowsource. With the code I get now, I am getting multiple instances of the same value, which is unnecessary.

 

[Tinbendr]

Dim Unique As New Collection
Dim Rng As Range, Cell As Range
Dim A As Long
    
    With Worksheets(1)
        Set Rng = .Range("G6", .Range("G6").End(xlDown))
    End With
    'Store the address of all unique items.
    For Each Cell In Rng.Cells
        On Error Resume Next
        Unique.Add CStr(Cell.Address), CStr(Cell.Address)
        On Error GoTo 0
    Next Cell
    
    For A = 1 To Unique.Count
            With Me.cb_league1
            Set Rng = Range(Unique(A))
            .AddItem Rng
            .List(.ListCount - 1, 1) = Rng.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = Rng.Offset(0, 2).Value
        End With
    Next

 

[Ark68]

Hi Tinbendr,

Thanks for the reply. I wasn't able to get the results I was looking for..Following the application of the filters that are used to create the dataset at G6 in worksheet LISTS1, the result is a list of 17 "WMBA". Rather than having a combobox of 17 "WMBA", I'd like to reduce this to just 1 in this example. The filters create a dynamic list. Sometimes there may be multiple instances of several different values. In this example case its just one.

Private Sub lb_calibre1_Change()
    If UFEventsDisabled = True Then Exit Sub
    Dim calibre1 As String
    Dim cb_league1 As String
    Dim Rng As Range, cell As Range
    Dim Unique As New Collection
    Dim A As Long
    calibre1 = lb_calibre1.Value
    If calibre1 = "Select calibre ..." Then Exit Sub
    With Worksheets("Data")
        .AutoFilterMode = False
        .Range("A1").AutoFilter
        .Range("A1").AutoFilter Field:=1, Criteria1:=lb_sport1
        .Range("D1").AutoFilter Field:=4, Criteria1:=lb_calibre1
        .Range("B2", .Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
        Sheets("LISTS1").Range("G6").PasteSpecial xlPasteValues
     End With
    With Worksheets("LISTS1")
        Set Rng = .Range("G6", .Range("G6").End(xlDown))
    End With
    For Each cell In Rng.Cells
        On Error Resume Next
        Unique.Add CStr(cell.Address), CStr(cell.Address)
        On Error GoTo 0
    Next cell
    For A = 1 To Unique.Count
        With Me.cb_league1
            Set Rng = Range(Unique(A))
            .AddItem Rng
            .List(.ListCount - 1, 1) = Rng.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = Rng.Offset(0, 2).Value
        End With
    Next
    Me.cb_league1.Visible = True
    Me.cb_league1.SetFocus
End Sub

 

[Tinbendr]

Sorry! That should be

Unique.Add CStr(Cell.Address), CStr(Cell)

will get a unique list.

But I'm having trouble following your autofilter version.

 

[Ark68]

Fantastic! That did the trick, thanks.
In my testing though, I discovered something that I wasn't expecting.

I'm finding that sometimes, the filters are resulting in an empty dataset.

    .Range("B2", .Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
    Sheets("LISTS1").Range("G6").PasteSpecial xlPasteValues

So, in this scenario, the code above puts the header row value in the list (LIST1 G6) ... which isn't cool. How can I avoid this?

 

[Tinbendr]

If you're looking for a single answer, then using Range.Find could do that without creating a separate sheet.

If you could provide a link to a sample sheet, i could help with that. I use Box.net for that. Or, if you'd like to email me the sample, it's my username at google mail.

 

[Ark68]

Here's a link to my project David.

Run the userform, and select "slopitch" in the first list box, then select "rep" in the 2nd list box.
In the data, there are no rows of data that meet this filter criteria, but the combobox that appears becomes populated with header row value.

https://www.dropbox.com/s/st5qzl9oc2lu76e/Test4.xlsm?dl=0

Thanks so much for your help.

 

[Tinbendr]

So, each change event is basically the same. Iterate the column range, adding all to a collection. But you can't have duplicates in a collection, so it generates an error and will not add it. We take advantage of that and turn off the error checking until after the error occurs. What we end up with is a unique list. This can be accomplished without autofilter. We then stuff the collection into the control. When dealing with multiple unique lists, I usually create a subroutine with the collection code in it and pass either the range or just the column number, along with the control. The Sub iterates the range and stuffs the control.

What is your end result? Once you have parred down the list, what are you looking for? And what are you going to do with it?

E.g. with the autofilter commented out.

    If calibre1 = "Select calibre ..." Then Exit Sub
    With Worksheets("Data")
'        .AutoFilterMode = False
'        .Range("A1").AutoFilter
'        .Range("A1").AutoFilter Field:=1, Criteria1:=lb_sport1
'        .Range("D1").AutoFilter Field:=4, Criteria1:=lb_calibre1
'        .Range("B2", .Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
'        Sheets("LISTS1").Range("G6").PasteSpecial xlPasteValues
'     End With
'    With Worksheets("LISTS1")
        Set Rng = .Range("G6", .Range("G6").End(xlDown))
    End With
    For Each cell In Rng.Cells
        On Error Resume Next
        Unique.Add CStr(cell.Address), CStr(cell)
        On Error GoTo 0
    Next cell
    For A = 1 To Unique.Count
        With Me.cb_league1
            Set Rng = Range(Unique(A))
            .AddItem Rng
            .List(.ListCount - 1, 1) = Rng.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = Rng.Offset(0, 2).Value
        End With
    Next
    Me.cb_league1.Visible = True
    Me.cb_league1.SetFocus

 

[Ark68]

Good day David,

So, with the filter eliminated as suggested, I'm finding that the applications hangs and fails to respond following the change in lb_calibre1.

Basically what I am trying to accomplish with this learning opportunity is ...

1) User selects a sport from predefined list in lb_sport1 (column A in worksheet DATA)
2) User selects a calibre for that sport from a predefined list in lb_calibre (column D in worksheet DATA)
3) User selects a league (if it exists) from the unique results of data (column B worksheet "DATA") filtered by lb_sport1 and lb_calibre from cb_league1. If there are no results from that filter (dataset is empty), user enters custom value into combobox cb_league1
4) Once the value of cb_league1 is obtained, data (columc worksheet DATA) is filtered yet again based on this value. A new combobox opens (cb_program1) populated by the results of the newly filtered database (column C). There should be no duplicates. Once again, if no value exists, the user will enter a custom value.
5) Now that the user has found a particular group, the remainder of the userform (not programmed yet) will populate with the pre-existing data from column E-P worksheet data. If there is no match, the user will enter custom data.

Really appreciate your help David. Everyone here at Mr. Excel has been exceptionally patient and understanding.

 

[Tinbendr]

OK, I've been rereading this for a while, but I'm no closer.

...If there are no results from that filter (dataset is empty), user enters custom value into combobox cb_league1
4) Once the value of cb_league1 is obtained,

But if you create a customer (unique) league, then there will be no more entries for a filter to act on. That's the 'drawback' in working with autofiler, you always have to test after each filter to check for zero entries. (Back to post #5, how do you not show headers? Well, you don't, if the result is no records. You have to test for it.

Also, I'm still not clear what you're trying to accomplish. I realize that eventually, you plan to add this to the list. But what is the purpose for doing so? Do you have a set of records to add, and you're using the unique list to lookup all possible entries to make data entry easier?

I think I know what you want, but I'd like to be sure before spending a lot of time rewriting this in vain.