Combo Box Listing w/ Duplicate Count and Search HELP!!!

[eltorito]

Hey Everyone,

I'm trying to make a combo box that lists only unique entries in 2 columns but also has a count in brackets beside the entry. For example:

Apples (8)
Bananas (13)
Grapes (2)

The code I have to populate the box is:

Sub RemoveDuplicates()
    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Dim i As Integer, j As Integer
    Dim Swap1, Swap2, Item
    
    Set AllCells = Range("e3:f370")
    
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
    Next Cell

    On Error GoTo 0
    
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add Swap1, before:=j
                NoDupes.Add Swap2, before:=i
                NoDupes.Remove i + 1
                NoDupes.Remove j + 1
            End If
        Next j
    Next i
    
    For Each Item In NoDupes
        UserForm1.ComboBox1.AddItem Item
    Next Item

    UserForm1.Show
End Sub

What can I add to count how many times an entry is listed in my range? Also, the filter works off text from the combo box, how can I remove the counts prior to filtering? Here's what I'm using now to filter:

Private Sub SrchBtn_Click()
Worksheets("sheet1").Range("b1") = ComboBox1.Value
Range("A2:J1000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("L1:M3"), Unique:=False
ActiveWindow.SmallScroll Down:=-5
Unload Me
End Sub

Please help a newb!

 

[Legacy 68668]

try

Sub RemoveDuplicates()
    Dim a, e, w()
 
    a = Range("e3:f370").Value
 
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each e In a
            If e <> "" Then
                If Not .exists(e) Then
                    .item(e) = VBA.Array(e, "(1)")
                Else
                    w = .item(e) 
                    w(1) = "(" & Replace(Replace(w(1),"(",""),")","") + 1 & ")"
                    .item(e) = w
                End If
             End If
         Next
         UserForm1.ComboBox1.List = _
         Application.Transpose(Application.Transpose(.items))
    End With    
    UserForm1.Show
End Sub

 

[eltorito]

Thanks for responding Seiya. I tried the code and it returns a list with unsorted unique items without the count. Very new to VBA and I can't see where it is going wrong.

 

[Legacy 68668]

Change the ColumnCount property of the ComboBox1 to 2.

 

[eltorito]

Changed the ColumnCount property as you suggested and the list is now sorted alphabetically, but still does not display the count.

 

[Legacy 68668]

Do you see 2 columns in ComboBox ?

 

[eltorito]

There was no distinct second column; ie: no separator, but it was wider and now had vertical scroll bar where it had not prior.

 

[Legacy 68668]

Try this one

Sub RemoveDuplicates()
    Dim a, e, w()
 
    a = Range("e3:f370").Value
 
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each e In a
            If e <> "" Then
                If Not .exists(e) Then
                    .item(e) = VBA.Array(e, "(1)")
                Else
                    w = .item(e) 
                    w(1) = "(" & Replace(Replace(w(1),"(",""),")","") + 1 & ")"
                    .item(e) = w
                End If
             End If
         Next
         UserForm1.ComboBox1.List = _
         Application.Transpose(Application.Transpose(.items))
    End With
    With UserForm1
        With .ComboBox1
            .ColumnCount = 2
            .ColumnWidths = "20;10"  '<- adjust to suite
        End With 
        .Show
    End Withy
End Sub

 

[eltorito]

It works, kind of. The list is sorted as it is entered in the spreadsheet, but it displays the count!! How can I get the alphabetical order back? Is there something in the ComboBox's properties?

 

[Legacy 68668]

How do you want it exactly?
Do you want the combobox with one column with count in bracket and sorted in alphabetical order ?
If so, and if you need to get the info from the combobox selected, you will need an extra effort....

Sub RemoveDuplicates()
    Dim a, e, x, y
    a = Range("e3:f370").Value 
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each e In a
            If e <> "" Then
                If Not .exists(e) Then
                    .item(e) = e & "(1)"
                Else
                    x = Split(.item(e), "(")
                    .item(e) = x(0) & "(" & Val(x(1)) + 1 & ")"
                End If
             End If
         Next
         y = .items
    End With
    SortA y, 0, UBound(y)
    With UserForm1
        With .ComboBox1
            .ColumnCount = 1
            .List = y
        End With
        .Show
    End With
End Sub
 
Private Sub SortA(ary, LB, UB)
 Dim M As Variant, i As Long, ii As Long, temp
 i = UB : ii = LB
 M = UCase(ary(Int((LB + UB)/2)))
 Do While ii <= i
      Do While UCase(ary(ii)) > M
           ii = ii + 1
      Loop
      Do While UCase(ary(i)) < M
           i = i - 1
      Loop
      If ii <= i Then
           temp = ary(ii) : ary(ii) = ary(i) : ary(i) = temp
           ii = ii + 1 : i = i - 1
      End If
 Loop
 If LB < i Then SortA ary, LB, i
 If ii < UB Then SortA ary, ii, UB
 End Sub