Excel (VBA) - UserForm Combobox > Listbox, stop duplicates

Question

Upon selecting a category from a combobox a listbox then updates with only records related to the combobox selection. However the list is producing duplicates and I was wondering how I prevent this from happening.

Private Sub ProdComp_Change()
Dim RowMax As Integer
Dim ws As Worksheet
Dim countexit As Integer
Dim cellcombo2 As String
Dim i As Integer

Set ws = ThisWorkbook.Sheets("products")
RowMax = ws.Cells(Rows.Count, "B").End(xlUp).Row

Me.LBType.Clear

With LBType
    For i = 2 To RowMax
        If ws.Cells(i, "B").Value = ProdComp.Text Then
        .AddItem ws.Cells(i, "c").Value
        Else
        End If
    Next i
End With

End Sub

Worksheet View

UserForm View

Please show some examples. Also, are you sure that there are no duplicates in your column B? — Luuklag
– Luuklag, Commented Apr 17, 2018 at 12:36
I have added two images, as you can see because each product has different variations, what I want to prevent happening is as you can see in the "UserForm View" to have each product type only show once as opposed to showing numerous times. However, as it is currently designed needs to accommodate for any new additions made. — Shadyjunior
– Shadyjunior, Commented Apr 17, 2018 at 12:44

Siddharth Rout · Accepted Answer · 2018-04-17 12:55:56Z

Try adding the items to a unique collection and then add the collection to the listbox. This way you will not get any duplicates.

Try this

Private Sub ProdComp_Change()
    '~~> when working with Rows, Please do not use `Integer`. Use `Long`
    Dim RowMax As Long, countexit As Long, i As Long
    Dim ws As Worksheet
    Dim cellcombo2 As String
    Dim col As New Collection, itm As Variant

    Set ws = ThisWorkbook.Sheets("products")
    RowMax = ws.Cells(Rows.Count, "B").End(xlUp).Row

    For i = 2 To RowMax
        If ws.Cells(i, "B").Value = ProdComp.Text Then
            '~~> On error resume next will
            '~~> create a unique collection
            On Error Resume Next
            col.Add ws.Cells(i, "c").Value, CStr(ws.Cells(i, "c").Value)
            On Error GoTo 0
        End If
    Next i

    Me.LBType.Clear

    If col.Count > 0 Then
        For Each itm In col
            LBType.AddItem itm
        Next
    End If
End Sub

If you have too much of data then you can copy the data to the array instead of looping through rows and then create the unique collection.

Subodh Tiwari sktneer · Accepted Answer · 2018-04-17 12:49:23Z

0

You may give this a try...

Private Sub ProdComp_Change()
Dim RowMax As Integer
Dim ws As Worksheet
Dim countexit As Integer
Dim cellcombo2 As String
Dim i As Integer
Dim dict

Set ws = ThisWorkbook.Sheets("products")
RowMax = ws.Cells(Rows.Count, "B").End(xlUp).Row
Set dict = CreateObject("Scripting.Dictionary")

Me.LBType.Clear

With LBType
    For i = 2 To RowMax
        If ws.Cells(i, "B").Value = ProdComp.Text Then
            dict.Item(ws.Cells(i, "c").Value) = ""
        End If
    Next i
    If dict.Count > 0 Then .List = dict.keys
End With
End Sub

answered Apr 17, 2018 at 12:49

Subodh Tiwari sktneer

9,9862 gold badges20 silver badges22 bronze badges

2 Comments

Shadyjunior Over a year ago

That has worked perfectly! Thank you, I have been wracking my brain on how to do this correctly!

Subodh Tiwari sktneer Over a year ago

@R.Langdell You're welcome! Glad it worked as desired. :)

Collectives™ on Stack Overflow

Excel (VBA) - UserForm Combobox > Listbox, stop duplicates

2 Answers 2

Comments

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related