combobox from unique values

roninn75 · Aug 29, 2015

Hi
i have a sheet called Ranges where i store 4 related columns of data on. on a second sheet called Summary I have 4 dependant comboboxes.
Combobox1 list values from column A on the Ranges sheet

the following code runs in the Worksheet_Activate event

Code:

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range


Set ws1 = Sheets("Ranges")
Set ws2 = Sheets("Summary")


'lets first add the district values
For Each rng In ws1.Range("DISTRICT")
With Me.BxDistrict
    .AddItem rng.Value
End With
Next rng

i want to now populate combobox2 with unique values from the next related column
so i set the related range to go look in:

Code:

With ws1
        Set rng = .Range(.Range("I2"), .Range("I100").End(xlUp))
End With

and here is where things start going weird:

Code:

Dim CL as range
Dim ClAddress As String
Dim coll As New Collection
        With Me.BxStn
        .Clear
        Set Cl = rng.Find(What:=Me.BxDistrict.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Cl Is Nothing Then
            ClAddress = Cl.Address
            Do
                On Error Resume Next
                coll.Add Item:=Cl.Offset(0, 1).Value, Key:=CStr(Cl.Offset(0, 1).Value)
                On Error GoTo 0
                Set Cl = rng.FindNext(After:=Cl)
            Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
        End If
        For Each itm In coll
            Me.BxStn.AddItem itm
        Next itm
    End With

Code:

'lets add the unique platoon names
With ws1
        Set rng = .Range(.Range("J2"), .Range("J100").End(xlUp))
    End With
    With Me.BxPlt
        .Clear
        Set Cl = rng.Find(What:=Me.BxStn.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Cl Is Nothing Then
            ClAddress = Cl.Address
            Do
                On Error Resume Next
                coll.Add Item:=Cl.Offset(0, 1).Value, Key:=CStr(Cl.Offset(0, 1).Value)
                On Error GoTo 0
                Set Cl = rng.FindNext(After:=Cl)
            Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
        End If
        For Each itm In coll
            Me.BxPlt.AddItem itm
        Next itm
    End With

Code:

'lets add the unique staff names list
    With ws1
        Set rng = .Range(.Range("K2"), .Range("K100").End(xlUp))
    End With
    With Me.BxName
        .Clear
        Set Cl = rng.Find(What:=Me.BxPlt.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Cl Is Nothing Then
            ClAddress = Cl.Address
            Do
                On Error Resume Next
                coll.Add Item:=Cl.Offset(0, 1).Value, Key:=CStr(Cl.Offset(0, 1).Value)
                On Error GoTo 0
                Set Cl = rng.FindNext(After:=Cl)
            Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
        End If
        For Each itm In coll
            Me.BxName.AddItem itm
        Next itm
    End With

comboboxes 3 and 4 are not pulling the unique values from the next columns through, instead it just repeats the values from the 2nd combobox.
Your assistance is appreciated.

RickXL · Aug 30, 2015

Hi,

I think this should work for the column K example above if all you need is unique values from column K:

Code:

Sub GetUnique()
    Dim dic As Object, ws1 As Worksheet, i As Long
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set dic = CreateObject("Scripting.Dictionary")
    Me.BxName.Clear
    
    For i = 2 To ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row
        dic(ws1.Cells(i, "K").Value) = ""
    Next
    
    For i = 0 To dic.Count - 1
        Me.BxName.AddItem dic.Keys()(i)
    Next
End Sub

I assumed ws1 was Sheet1 and that Me would know about the BxName object.

roninn75 · Aug 30, 2015

thanks for your reply RickXL but these has to filter the related values in the previous column.
column I = DISTRICT containing West, East and North for example.
column J = STATION containing some station names some

DISTRICT	STATION	PLT	NAME
West	stationA	1	John
West	stationB	2	Peter
West	stationA	1	Shaun
West	stationA	1	Joey
North	stationC	1	Paul
East	stationD	1	Mike

combobox1 contains: West, North, East
if "West" selected then
combobox2 contains: stationA, stationB
if "stationA selected then
combobox3 contains: 1
if "1" selected then
combobox4 contains: John, Shaun, Joey

RickXL · Aug 30, 2015

OK, Gotcha ...

So more like this then:

Code:

Private Sub BxDistrict_Change()
    Dim dic As Object, ws1 As Worksheet, i As Long
    
    Set ws1 = ThisWorkbook.Worksheets("Ranges")
    Set dic = CreateObject("Scripting.Dictionary")
    Me.BxStn.Clear
    
    For i = 2 To ws1.Cells(ws1.Rows.Count, "J").End(xlUp).Row
        If BxDistrict.Value = ws1.Cells(i, "I").Value Then dic(ws1.Cells(i, "J").Value) = ""
    Next
    
    For i = 0 To dic.Count - 1
        Me.BxStn.AddItem dic.Keys()(i)
    Next
End Sub

Private Sub BxStn_Change()
    Dim dic As Object, ws1 As Worksheet, i As Long
    
    Set ws1 = ThisWorkbook.Worksheets("Ranges")
    Set dic = CreateObject("Scripting.Dictionary")
    Me.BxPlt.Clear
    
    For i = 2 To ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row
        If (BxDistrict.Value = ws1.Cells(i, "I").Value) And _
            (BxStn.Value = ws1.Cells(i, "J").Value) Then dic(ws1.Cells(i, "K").Value) = ""
    Next
    
    For i = 0 To dic.Count - 1
        Me.BxPlt.AddItem dic.Keys()(i)
    Next
End Sub

Private Sub BxPlt_Change()
    Dim dic As Object, ws1 As Worksheet, i As Long
    
    Set ws1 = ThisWorkbook.Worksheets("Ranges")
    Set dic = CreateObject("Scripting.Dictionary")
    Me.BxName.Clear
    
    For i = 2 To ws1.Cells(ws1.Rows.Count, "L").End(xlUp).Row
        If (BxDistrict.Value = ws1.Cells(i, "I").Value) And _
            (BxStn.Value = ws1.Cells(i, "J").Value) And _
            (CStr(BxPlt.Value) = ws1.Cells(i, "K").Value) Then dic(ws1.Cells(i, "L").Value) = ""
    Next
    
    For i = 0 To dic.Count - 1
        Me.BxName.AddItem dic.Keys()(i)
    Next
End Sub

Private Sub Worksheet_Activate()
    Dim ws1 As Worksheet
    Dim rng As Range

    Set ws1 = Sheets("Ranges")

    'lets first add the district values
    For Each rng In ws1.Range("DISTRICT")
        With Me.BxDistrict
            .AddItem rng.Value
        End With
    Next rng
End Sub

roninn75 · Aug 30, 2015

thank you RickXL

RickXL · Aug 30, 2015

No problem.

I am pleased we made it in the end

teuteux13 · Sep 25, 2016

Hy,

I have the same question but at the end i want only one result instead of several results

PRODUCT NAME	Weight	Price with VAT
ECO2000	16	700
ECO2000	160	4000
REN0100	16	600
REN0100	160	4200
REN0100	950	12000
ECO3000	16	400

Below it's what the combobox shoud display

combobox1 ECO2000, RENO100, ECO3000
if "ECO2000" selected then
combobox2 contains: 16, 160
if "16 selected then
combobox3 contains: 700 ONLY and not the other number = 16

My problem today with the code below when i select 16 the combobox 3 display 700,600 and 400 but i only want the result 700

how to do?

please check my code below thanks

Option Explicit
Dim rSource1 As Range
Dim rSource As Range

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Cl As Range
Dim ClAddress As String
With Me
'if no selection in combobox1 quit
If .ComboBox1.ListIndex < 0 Then Exit Sub
.ComboBox2.Clear
Set Cl = rSource.Find(Me.ComboBox1.Value)
If Not Cl Is Nothing Then
ClAddress = Cl.Address
Do
.ComboBox2.AddItem Cl.Offset(0, 1).Value
Set Cl = rSource.FindNext(Cl)
Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
End If
End With
End Sub
Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Cl1 As Range
Dim ClAddress1 As String
With Me
'if no selection in combobox2 quit
If .ComboBox2.ListIndex < 0 Then Exit Sub
.ComboBox3.Clear
Set Cl1 = rSource1.Find(Me.ComboBox2.Value)
If Not Cl1 Is Nothing Then
ClAddress1 = Cl1.Address
Do
.ComboBox3.AddItem Cl1.Offset(0, 1).Value
Set Cl1 = rSource1.FindNext(Cl1)
Loop While Not Cl1 And Cl1.Address <> ClAddress1
End If
End With
End Sub

Private Sub UserForm_Initialize()
'load combobox1
With Sheet1
Set rSource = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set rSource1 = .Range(.Cells(1, 2), .Cells(.Rows.Count, 1).End(xlUp))

End With
Me.ComboBox1.List = rSource.Value
Me.ComboBox2.List = rSource1.Value

End Sub

teuteux13 · Sep 26, 2016

Anyone can help please....

teuteux13 said:
Hy,

I have the same question but at the end i want only one result instead of several results

PRODUCT NAME Weight Price with VAT
ECO2000 16 700
ECO2000 160 4000
REN0100 16 600
REN0100 160 4200
REN0100 950 12000
ECO3000 16 400

<tbody>
</tbody>

Below it's what the combobox shoud display

combobox1 ECO2000, RENO100, ECO3000
if "ECO2000" selected then
combobox2 contains: 16, 160
if "16 selected then
combobox3 contains: 700 ONLY and not the other number = 16

My problem today with the code below when i select 16 the combobox 3 display 700,600 and 400 but i only want the result 700

how to do?

please check my code below thanks

Option Explicit
Dim rSource1 As Range
Dim rSource As Range

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Cl As Range
Dim ClAddress As String
With Me
'if no selection in combobox1 quit
If .ComboBox1.ListIndex < 0 Then Exit Sub
.ComboBox2.Clear
Set Cl = rSource.Find(Me.ComboBox1.Value)
If Not Cl Is Nothing Then
ClAddress = Cl.Address
Do
.ComboBox2.AddItem Cl.Offset(0, 1).Value
Set Cl = rSource.FindNext(Cl)
Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
End If
End With
End Sub
Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Cl1 As Range
Dim ClAddress1 As String
With Me
'if no selection in combobox2 quit
If .ComboBox2.ListIndex < 0 Then Exit Sub
.ComboBox3.Clear
Set Cl1 = rSource1.Find(Me.ComboBox2.Value)
If Not Cl1 Is Nothing Then
ClAddress1 = Cl1.Address
Do
.ComboBox3.AddItem Cl1.Offset(0, 1).Value
Set Cl1 = rSource1.FindNext(Cl1)
Loop While Not Cl1 And Cl1.Address <> ClAddress1
End If
End With
End Sub

Private Sub UserForm_Initialize()
'load combobox1
With Sheet1
Set rSource = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set rSource1 = .Range(.Cells(1, 2), .Cells(.Rows.Count, 1).End(xlUp))

End With
Me.ComboBox1.List = rSource.Value
Me.ComboBox2.List = rSource1.Value

End Sub

RickXL · Sep 26, 2016

Hi and welcome to the MrExcel Message Board.

I am sorry but I am busy right now so have not had time to look at your problem.

In any case, you would be better off starting a thread of your own. That way it will be more easily visible to everyone and not just me.
When you do that, make sure the question is clear enough so that someone can solve it without asking any questions and also, don't be tempted to "bump" the message because that removes it from the default search of "zero answers" so many people will never find it.

Thanks,

MickG · Sep 26, 2016

Try this:-
Your Data in sheet1
Comboboxes in sheet2
NB:- The code is loaded by Double clicking Combobox1, it will not show any selection until one is made.
The other comboboxes will load based on the previous combobox selection.
NB:- Paste the entire code at the top of sheet2 code Module.

Code:

Option Explicit
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
Private [COLOR="Navy"]Sub[/COLOR] ComboBox1_DblClick(ByVal Cancel [COLOR="Navy"]As[/COLOR] MSForms.ReturnBoolean)
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
 [COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
   [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
 [COLOR="Navy"]End[/COLOR] With
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
           [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
        [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
           Dic(Dn.Value).Add (Dn.Offset(, 1).Value), Dn.Offset(, 2).Value
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
   
  [COLOR="Navy"]With[/COLOR] ComboBox1
     .List = Dic.Keys
     .ListIndex = -1
  [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Private [COLOR="Navy"]Sub[/COLOR] ComboBox1_Change()
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant
ComboBox2.Clear: ComboBox3.Clear
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.Keys
  [COLOR="Navy"]If[/COLOR] K = ComboBox1.Value [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(K)
        ComboBox2.AddItem p
   [COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Private [COLOR="Navy"]Sub[/COLOR] ComboBox2_Change()
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant
ComboBox3.Clear
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.Keys
  [COLOR="Navy"]If[/COLOR] K = ComboBox1.Value [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(K)
        [COLOR="Navy"]If[/COLOR] p = Val(ComboBox2.Value) [COLOR="Navy"]Then[/COLOR] ComboBox3.AddItem Dic(K).Item(p)
   [COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

combobox from unique values

roninn75

New Member

Excel Facts

RickXL

MrExcel MVP

roninn75

New Member

RickXL

MrExcel MVP

roninn75

New Member

RickXL

MrExcel MVP

teuteux13

New Member

teuteux13

New Member

RickXL

MrExcel MVP

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

combobox from unique values

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

MrExcel MVP

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock