Very inexperienced and found code for cascading comboboxes. I tried resolving the errors with no luck, but I think with some help this could work.
Here's how I need it to work...
Step 1: Select a customer name from the drop-down.
Step 2: Select a customer ID from the drop-down, limited to selections that match Step 1
Step 3: Select a Ship To Name from the drop-down, limited to selections that match Step 2
Step 4: Select a Ship To ID from the drop-down, limited to selections that match Step 3
The worksheet that holds the customer data is titled: "Customers".
Customers and End Users are sometimes the same. Their names are listed in Column 1 and their IDs are listed in Column 2. I need to track the End Users in a separate smaller cascade.
Step 1: Select an end user name from the drop-down.
Step 2: Select an end user ID from the drop-down, limited to selections that match Step 1
If I open the userform > and click on one of the orders in the listbox, I get an error message.
Private Sub cboCustID_Change()
cboSTName.Clear
cboSTID.Clear
If cboCustID.ListIndex < 0 Then Exit Sub
cboSTName.List = oDic(cboCustID.Text) 'Cascade for cboSTName is dependent upon cboCustID 'Run-time error 381: Could not set List property. Invalid property array index.
cboSTName.Enabled = cboSTName.ListCount > 1
cboSTName.ListIndex = 0
cboSTName.Text = "***SELECT SHIP TO NAME***"
If I open the userform > go to the Customer Tab and try to select a customer name. I get the same error on the same line of code.
If I open the userform > go to the Customer Tab, skip selecting a customer name, and select end user name. That smaller cascade is working perfectly.
I would be happy to attach the file, but I don't see that as an option. So, here is all of the code relating to the cascading comboboxes...
Dim oDic As Object '***Cascading comboboxes. oDIC is a module global Object variable.
'Since the Object will be used within several procedures (Initialize, Change, Terminate)...the code is outside of all procedures
Dim CommonButtons As Collection
Private Sub UserForm_Initialize()
'redacted unrelated code
'***Cascading comboboxes for Customer and Ship-To***
Const d = "¤" 'Declaring a constant, D = "currency sign (As String)" D is the delimiter used within Join & Split functions
Dim V 'As Variant (array) which is the "Customers" worksheet data minus the header
Dim r As Long 'number
Dim c As String 'text
Dim K As String 'text
Set customerTable = Worksheets("Customers").ListObjects("tblCustomers") 'referencing the ListObject named "tblCustomers"
V = customerTable.DataBodyRange.Columns("A:Z") 'DataBodyRange is just the table data, it excludes the header/total sections of the table
Set oDic = CreateObject("Scripting.Dictionary")
'Variable oDic created outside all procedures
'CreateObject("Scripting.Dictionary") creates a Dictionary object, which can be any form of data stored in an array. Each item is associated with a unique key.
For r = 1 To UBound(V) '1 to the highest subscript for the dimension of array "V"
c = V(r, 2) 'text string = cboCustID (col 2)
K = c & V(r, 18) 'K = cboCustID (col 2) & cboSTName (col 18)
If oDic.Exists(V(r, 1)) Then
'Cascading step 1: Customer Name (col 1) is selected cboName
If oDic.Exists(c) Then
'Cascading step 2: Only the CustID(s) in (col 2) that exist and 'match' the Customer Name appear in the cboCustID
If oDic.Exists(K) Then
'Cascading step 3: Only the STName(s) in (col 18) that exist and 'match' the Customer Name + CustID will appear in the combo box
oDic(K) = Split(Join(oDic(K), d) & d & V(r, 19), d)
'Cascading Step 4: Only the STID(s) in col 19 that exist and 'match' the Customer Name + CustID + STName will appear in the combo box
'Split(Join(cboSTName,"d") & ("d" & cboSTID,"d") "d" = delimiter
Else
oDic(c) = Split(Join(oDic(c), d) & d & V(r, 18), d)
'Split(Join(cboCustID,"d","d",cboSTName,"d") "d" = delimiter
oDic.Add K, Array(V(r, 19)) 'adds cboCustID & cboSTName to array of cboSTID
End If
Else
oDic(V(r, 1)) = Split(Join(oDic(V(r, 1)), d) & d & c, d)
'cboName = cboName,"d","d",cboCustID,"d"
oDic.Add c, Array(V(r, 18)) 'cboCustID,cboSTName
oDic.Add K, Array(V(r, 19)) 'cboCustID,cboSTName,cboSTID
End If
Else
cboName.AddItem V(r, 1) 'adds a new key/item, i.e., cboName to the array
oDic.Add V(r, 1), Array(c) 'adds a new key/item, i.e., cboName to array of cboCustID
oDic.Add c, Array(V(r, 18)) 'adds a new key/item, i.e., cboCustID to array of cboSTName
oDic.Add K, Array(V(r, 19)) 'adds a new key/item, i.e., cboSTName to array of cboSTID
End If
Next
cboName.Enabled = cboName.ListCount > 1
cboName.ListIndex = 0
cboName.Text = "***SELECT CUSTOMER***"
cboCustID.Text = ""
Me.txtBT = ""
Me.txtBTAddr1 = ""
Me.txtBTAddr2 = ""
Me.txtBTCity = ""
Me.txtBTState = ""
Me.txtBTZip = ""
Me.txtBTCntry = ""
'***Cascading comboboxes for End User Name and End User ID***
Const f = "¤" 'Declaring a constant, f = "currency sign (As String)" f is the delimiter used within Join & Split functions
Dim Va 'As Variant (array) which is the "Customers" worksheet data minus the header
Dim q As Long 'number (formerly 'r')
Dim e As String 'text (cboEUID) (formerly 'c')
Dim L As String 'text (cboEUName & cboEUID)
Set customerTable = Worksheets("Customers").ListObjects("tblCustomers") 'referencing the ListObject named "tblCustomers"
Va = customerTable.DataBodyRange.Columns("A:Z") 'DataBodyRange is just the table data, it excludes the header/total sections of the table
Set oDic = CreateObject("Scripting.Dictionary")
'Variable oDic created outside all procedures
'CreateObject("Scripting.Dictionary") creates a Dictionary object, which can be any form of data stored in an array. Each item is associated with a unique key.
For q = 1 To UBound(V) '1 to the highest subscript for the dimension of array "Va"
e = Va(q, 2) 'text string = cboEUID (col 2)
If oDic.Exists(Va(q, 1)) Then
'Cascading step 1: End User Name (col 1) is selected cboEUName
If oDic.Exists(e) Then
'Cascading step 2: Only the EUID(s) in (col 2) that exist and 'match' the End User Name appear in the cboEUID
oDic(Va(q, 1)) = Split(Join(oDic(Va(q, 1)), f) & f & e, f)
'cboEUName = cboEUName,"f","f",cboEUID,"f"
End If
Else
cboEUName.AddItem Va(q, 1) 'adds a new key/item, i.e., cboEUName to the array
oDic.Add Va(q, 1), Array(e) 'adds a new key/item, i.e., cboEUName to array of cboEUID
End If
Next
cboEUName.Enabled = cboEUName.ListCount > 1
cboEUName.ListIndex = 0
cboEUName.Text = "***SELECT CUSTOMER***"
cboEUID.Text = ""
Me.txtEUAddr1 = ""
Me.txtEUAddr2 = ""
Me.txtEUCity = ""
Me.txtEUState = ""
Me.txtEUZip = ""
Me.txtEUCntry = ""
End Sub
'***CASCADING COMBOBOXES STARTS HERE OUTSIDE OF INITIALIZATION****
'Cascading order: 1. cboName, 2. cboCustID, 3. cboSTName, 4. cboSTID
Private Sub cboName_Change()
cboCustID.Clear
cboSTName.Clear
cboSTID.Clear
If cboName.ListIndex < 0 Then Exit Sub
cboCustID.List = oDic(cboName.Text) 'Cascade starts...+
cboCustID.Enabled = cboCustID.ListCount > 1
cboCustID.ListIndex = 0
'***Pop-up Warning Message for Specific Customers***
'redacted unrelated code
End Sub
Private Sub cboCustID_Change()
cboSTName.Clear
cboSTID.Clear
If cboCustID.ListIndex < 0 Then Exit Sub
cboSTName.List = oDic(cboCustID.Text) 'Cascade for cboSTName is dependent upon cboCustID 'Run-time error 381: Could not set List property. Invalid property array index.
cboSTName.Enabled = cboSTName.ListCount > 1
cboSTName.ListIndex = 0
cboSTName.Text = "***SELECT SHIP TO NAME***"
'Populates the Customer Address information based on the Customer ID that is selected
Dim i As Long, LastRow As Long, wsh As Worksheet
Set wsh = Sheets("CUSTOMERS") '"Set" sets an object reference vs to assigning a value
LastRow = wsh.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow 'Loop
If Val(Me.cboCustID.Value) = wsh.Cells(i, "B") Then
Me.txtBT = wsh.Cells(i, "K").Value
Me.txtBTAddr1 = wsh.Cells(i, "C").Value
Me.txtBTAddr2 = wsh.Cells(i, "D").Value
Me.txtBTCity = wsh.Cells(i, "E").Value
Me.txtBTState = wsh.Cells(i, "F").Value
Me.txtBTZip = wsh.Cells(i, "G").Value
Me.txtBTCntry = wsh.Cells(i, "H").Value
'Need to add txtDiamond, txtTE, txtCon1, txtEmail1, txtCon2, txtEmail2.
Me.txtSTAddr1 = ""
Me.txtSTAddr2 = ""
Me.txtSTAddr3 = ""
Me.txtSTCity = ""
Me.txtSTState = ""
Me.txtSTZip = ""
Me.txtSTCntry = ""
Else
If Me.txtBT.Value = "" Then Me.txtBT.Value = "Same As Sold To"
End If
Next i
End Sub
Private Sub cboSTName_Change()
cboSTID.Clear: If cboSTName.ListIndex < 0 Then Exit Sub
cboSTID.List = oDic(cboCustID.Text & cboSTName.Text)
cboSTID.Enabled = cboSTID.ListCount > 1
cboSTID.ListIndex = 0
End Sub
Private Sub UserForm_Terminate()
oDic.RemoveAll: Set oDic = Nothing
End Sub
Private Sub cboSTID_Change()
'Populates the Ship To Address Information based on the Customer ID AND Ship To ID selected
Dim i As Long, LastRow As Long, wsh As Worksheet
Set wsh = Sheets("CUSTOMERS")
LastRow = wsh.Range("S" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Val(Me.cboCustID.Value) = wsh.Cells(i, "B") And Val(Me.cboSTID.Value) = wsh.Cells(i, "S") Then
Me.txtSTAddr1 = wsh.Cells(i, "T").Value
Me.txtSTAddr2 = wsh.Cells(i, "U").Value
Me.txtSTCity = wsh.Cells(i, "W").Value
Me.txtSTState = wsh.Cells(i, "X").Value
Me.txtSTZip = wsh.Cells(i, "Y").Value
Me.txtSTCntry = wsh.Cells(i, "Z").Value
End If
Next i
End Sub
'***Cascading ComboBoxes for End User Information***
Private Sub cboEUName_Change()
Dim e, U As Long
Dim Rg(2) As Range
cboEUID.Clear
If cboEUName.ListIndex < 0 Then Exit Sub
With Sheets("CUSTOMERS").ListObjects(1).Range.Columns(1)
Set Rg(2) = .Parent.Range(.Find(cboEUName.Text, , xlValues, 1, , 1)(1, 2), .Find(cboEUName.Text, , xlValues, 1, , 2)(1, 2)) 'Run-Time error 91: object variable or with block variable not set
End With
e = Rg(2)
If IsArray(e) Then
cboEUID.AddItem e(1, 1)
For U = 2 To UBound(e)
If e(U, 1) <> e(U - 1, 1) Then cboEUID.AddItem e(U, 1)
Next
Else
cboEUID.AddItem e
End If
cboEUID.ListIndex = cboEUID.ListCount > 1
End Sub
Private Sub cboEUID_Change()
'Populates the End User Address Information based on the End User ID. End User information is the same as the Customer information.
Dim i As Long, LastRow As Long, wsh As Worksheet
Set wsh = Sheets("CUSTOMERS")
LastRow = wsh.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Val(Me.cboEUID.Value) = wsh.Cells(i, "B") Then
Me.txtEUAddr1 = wsh.Cells(i, "C").Value
Me.txtEUAddr2 = wsh.Cells(i, "D").Value
Me.txtEUCity = wsh.Cells(i, "E").Value
Me.txtEUState = wsh.Cells(i, "F").Value
Me.txtEUZip = wsh.Cells(i, "G").Value
Me.txtEUCntry = wsh.Cells(i, "H").Value
End If
Next i
End Sub
If you are so kind as to assist me, please add/edit the comments in the code, if possible. It helps me to learn. Thank you in advance.