Abdo
06-11-2022, 03:22 AM
Hi experts
I search for way to fixing my problem .
I know from the beginning my question is so complicated . the userform contains multiple rows , each row contains( 4 comboboxes & 1 textbox) . so when see the lables for all of comboboxes should match with the headers in sheet and when select item from combobox1 automatically fill combobox2 and when select item from combobox2 automatically fill combobox3 and when select item from combobox3 automatically fill combobox4 and when select item from combobox4 will fill the textbox 19 . so the columns 1,2,3,4,5 on userform link with columns B,C,D,E,F . every combobox depends on each other of them , when select one of them and depends on adjacent cell when match the columns inside sheet for each combobox when selected item for combobox separately .
so far it gives error object required in this line
If Not dic(a(i, 3)).exists(a(i, 4))
this is the whole code
Option ExplicitPrivate dic As Object
Private Sub UserForm_Initialize()
Dim a, i As Long, ii As Long
Set dic = CreateObject("Scripting.Dictionary")
a = Sheets("PRICES").Cells(1).CurrentRegion.Value
For i = 2 To UBound(a, 1)
For ii = 1 To UBound(a, 2)
a(i, ii) = a(i, ii) & ""
Next
If Not dic.exists(a(i, 2)) Then
Set dic(a(i, 2)) = CreateObject("Scripting.Dictionary")
End If
If Not dic(a(i, 2)).exists(a(i, 3)) Then Set dic(a(i, 2))(a(i, 3)) = CreateObject("Scripting.Dictionary")
If Not dic(a(i, 3)).exists(a(i, 4)) Then Set dic(a(i, 3))(a(i, 4)) = CreateObject("Scripting.Dictionary")
dic(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)) = a(i, 6)
Next
a = mySort(dic.keys)
For i = 1 To 10 Step 4
Me("combobox" & i).List = a
Next
End Sub
Private Sub ComboBox1_Change()
GetList 1
End Sub
Private Sub ComboBox2_Change()
GetList 2
End Sub
Private Sub ComboBox3_Change()
GetList 3
End Sub
Private Sub ComboBox4_Change()
GetList 4
End Sub
Private Sub ComboBox5_Change()
GetList 5
End Sub
Private Sub ComboBox6_Change()
GetList 6
End Sub
Private Sub ComboBox7_Change()
GetList 7
End Sub
Private Sub ComboBox8_Change()
GetList 8
End Sub
Private Sub ComboBox9_Change()
GetList 9
End Sub
Private Sub ComboBox10_Change()
GetList 10
End Sub
Private Sub ComboBox11_Change()
GetList 11
End Sub
Private Sub ComboBox12_Change()
GetList 12
End Sub
Private Sub GetList(CB)
Dim CB1, i As Long, x
CB1 = Application.Lookup(CB, Array(1, 5, 9, 13), Array(1, 5, 9, 13))
Me("textbox" & Application.RoundUp(CB1 / 4, 0)) = ""
For i = CB1 To CB1 + 3
If CB < i Then Me("combobox" & i).Clear
Next
If Me("combobox" & CB).ListIndex = -1 Then Exit Sub
x = CB1 + 3 - CB
If x = 2 Then
Me("combobox" & CB + 1).List = mySort(dic(Me("combobox" & CB1).Value).keys)
ElseIf x = 1 Then
Me("combobox" & CB + 1).List = mySort(dic(Me("combobox" & CB1).Value)(Me("combobox" & CB).Value).keys)
End If
If CB = CB1 + 3 Then Me("textbox" & Application.RoundUp(CB1 / 4, 0)) = _
dic(Me("combobox" & CB1).Value)(Me("combobox" & CB1 + 1).Value)(Me("combobox" & CB1 + 3).Value)
End Sub
Function mySort(a)
Dim i As Long, ii As Long, temp
For i = LBound(a) To UBound(a) - 1
For ii = i + 1 To UBound(a)
If a(i) > a(ii) Then
temp = a(i): a(i) = a(ii): a(ii) = temp
End If
Next
Next
mySort = a
End Function
I hope from expert helps me to complete this project .
I search for way to fixing my problem .
I know from the beginning my question is so complicated . the userform contains multiple rows , each row contains( 4 comboboxes & 1 textbox) . so when see the lables for all of comboboxes should match with the headers in sheet and when select item from combobox1 automatically fill combobox2 and when select item from combobox2 automatically fill combobox3 and when select item from combobox3 automatically fill combobox4 and when select item from combobox4 will fill the textbox 19 . so the columns 1,2,3,4,5 on userform link with columns B,C,D,E,F . every combobox depends on each other of them , when select one of them and depends on adjacent cell when match the columns inside sheet for each combobox when selected item for combobox separately .
so far it gives error object required in this line
If Not dic(a(i, 3)).exists(a(i, 4))
this is the whole code
Option ExplicitPrivate dic As Object
Private Sub UserForm_Initialize()
Dim a, i As Long, ii As Long
Set dic = CreateObject("Scripting.Dictionary")
a = Sheets("PRICES").Cells(1).CurrentRegion.Value
For i = 2 To UBound(a, 1)
For ii = 1 To UBound(a, 2)
a(i, ii) = a(i, ii) & ""
Next
If Not dic.exists(a(i, 2)) Then
Set dic(a(i, 2)) = CreateObject("Scripting.Dictionary")
End If
If Not dic(a(i, 2)).exists(a(i, 3)) Then Set dic(a(i, 2))(a(i, 3)) = CreateObject("Scripting.Dictionary")
If Not dic(a(i, 3)).exists(a(i, 4)) Then Set dic(a(i, 3))(a(i, 4)) = CreateObject("Scripting.Dictionary")
dic(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)) = a(i, 6)
Next
a = mySort(dic.keys)
For i = 1 To 10 Step 4
Me("combobox" & i).List = a
Next
End Sub
Private Sub ComboBox1_Change()
GetList 1
End Sub
Private Sub ComboBox2_Change()
GetList 2
End Sub
Private Sub ComboBox3_Change()
GetList 3
End Sub
Private Sub ComboBox4_Change()
GetList 4
End Sub
Private Sub ComboBox5_Change()
GetList 5
End Sub
Private Sub ComboBox6_Change()
GetList 6
End Sub
Private Sub ComboBox7_Change()
GetList 7
End Sub
Private Sub ComboBox8_Change()
GetList 8
End Sub
Private Sub ComboBox9_Change()
GetList 9
End Sub
Private Sub ComboBox10_Change()
GetList 10
End Sub
Private Sub ComboBox11_Change()
GetList 11
End Sub
Private Sub ComboBox12_Change()
GetList 12
End Sub
Private Sub GetList(CB)
Dim CB1, i As Long, x
CB1 = Application.Lookup(CB, Array(1, 5, 9, 13), Array(1, 5, 9, 13))
Me("textbox" & Application.RoundUp(CB1 / 4, 0)) = ""
For i = CB1 To CB1 + 3
If CB < i Then Me("combobox" & i).Clear
Next
If Me("combobox" & CB).ListIndex = -1 Then Exit Sub
x = CB1 + 3 - CB
If x = 2 Then
Me("combobox" & CB + 1).List = mySort(dic(Me("combobox" & CB1).Value).keys)
ElseIf x = 1 Then
Me("combobox" & CB + 1).List = mySort(dic(Me("combobox" & CB1).Value)(Me("combobox" & CB).Value).keys)
End If
If CB = CB1 + 3 Then Me("textbox" & Application.RoundUp(CB1 / 4, 0)) = _
dic(Me("combobox" & CB1).Value)(Me("combobox" & CB1 + 1).Value)(Me("combobox" & CB1 + 3).Value)
End Sub
Function mySort(a)
Dim i As Long, ii As Long, temp
For i = LBound(a) To UBound(a) - 1
For ii = i + 1 To UBound(a)
If a(i) > a(ii) Then
temp = a(i): a(i) = a(ii): a(ii) = temp
End If
Next
Next
mySort = a
End Function
I hope from expert helps me to complete this project .