2 ComboBox

[haseft]

hi,
I have a userform with 2 listbox,
ListBox1, pupulate uniqe items from column B in Sheet1, workning well,

Need help with ComboBox2.
want to fill ComboBox2 with criteria choosen fron ComboBox1
ComboBox2 should show item from column A in Sheet1
Tanks,

Private Sub UserForm_Initialize()
Dim myCollection As Collection, cell As Range

On Error Resume Next
Set myCollection = New Collection
With ComboBox1
  .Clear
For Each cell In Sheets("Sheet1").Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
If Len(cell) <> 0 Then
  Err.Clear
  myCollection.Add cell.Value, cell.Value
  If Err.Number = 0 Then .AddItem cell.Value
End If
Next cell
End With
ComboBox1.ListIndex = 0

End Sub

Private Sub ComboBox1_Change()
'want to fill ComboBox2 with criteria choosen from ComboBox1
'ComboBox2 should show items from column A in Sheet1

With ComboBox2
.ColumnCount = 1
.ColumnWidths = "50"
.ColumnHeads = True
[B]'how ?[/B]


End With
End Sub

 

[Fluff]

How about

Dim UfDic As Object

Private Sub ComboBox1_Change()
   Me.ComboBox2.Clear
   Me.ComboBox2.List = UfDic(Me.ComboBox1.Value).keys
End Sub

Private Sub UserForm_Initialize()
   Dim Cl As Range
   Set UfDic = CreateObject("scripting.dictionary")
   UfDic.CompareMode = 1
   With Sheets("Sheet1")
      For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
         If Not UfDic.Exists(Cl.Value) Then UfDic.Add Cl.Value, CreateObject("scripting.dictionary")
         UfDic(Cl.Value)(Cl.Offset(, -1).Value) = Empty
      Next Cl
   End With
   Me.ComboBox1.List = UfDic.keys
End Sub

The line in blue must go at the very top of the module, before any code

 

[haseft]

Thanks Fluff,
its workning
I have another problem,

'under ComboBox2 there is 3 texboxes
'i want to fill these texboxes data from column E, K and M in Sheet1
'based with criteria choosen from ComboBox2

Private Sub ComboBox2_Change()

'TextBox1.value = data from clomn E
'TextBox2.value = data from clomn K
'TextBox3.value = data from clomn M

'how

End Sub

 

[Fluff]

How about

Dim UfDic As Object

Private Sub ComboBox1_Click()
   Me.ComboBox2.Clear
   Me.ComboBox2.List = UfDic(Me.ComboBox1.Value).Keys
End Sub

Private Sub ComboBox2_Click()
   With UfDic(Me.ComboBox1.Value)
      Me.TextBox1 = .Item(Me.ComboBox2.Value)(0)
      Me.TextBox2 = .Item(Me.ComboBox2.Value)(1)
      Me.TextBox3 = .Item(Me.ComboBox2.Value)(2)
   End With
End Sub

Private Sub UserForm_Initialize()
   Dim Cl As Range
   Set UfDic = CreateObject("scripting.dictionary")
   UfDic.CompareMode = 1
   With Sheets("Sheet1")
      For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
         If Not UfDic.Exists(Cl.Value) Then UfDic.Add Cl.Value, CreateObject("scripting.dictionary")
         UfDic(Cl.Value)(Cl.Offset(, -1).Value) = Array(Cl.Offset(, 3).Value, Cl.Offset(, 9).Value, Cl.Offset(, 11).Value)
      Next Cl
   End With
   Me.ComboBox1.List = UfDic.Keys
End Sub

 

[haseft]

not workning,
get run error 13, incompatible
on row in Sub ComboBox2_Click()
Me.TextBox1 = .Item(Me.ComboBox2.Value)(0) ???

 

[Fluff]

Did you change the code in the Initalize event?

 

[haseft]

i just copied all your last codes

 

[Fluff]

Do you have any error in col E like #N/A, #NAME, #VALUE etc?

 

[haseft]

no,
column E contain text, som cells has notes on it

 

[Fluff]

The notes shouldn't make any difference, what is the exact error message that you get?