4 Dependent Combo Boxes

M

Magdoulin

Board Regular
Joined
Jan 11, 2013
Messages
73
Hi Guys,


I hope you’ll be able to assist me with the below code.

I’m trying to build 4 d active dependent Combo Boxes.

I got great assistance from one of the forum members here.

However, I’m afraid the code works perfectly till “Case 3000”, starting from this case, it doesn’t work properly at all.

Can someone check it for me? What is missing here?

Additionally, I need to know how to assign such macro to a button for example to trigger it?


Code: 
Private Sub UserForm_Initialize()
 
With ComboBox1
    .AddItem "Placement Tests"
    .AddItem "Courses"
    .AddItem "Miscellaneous"
End With
 
End Sub
 
 
 
 
Private Sub ComboBox1_Change()
 
ComboBox2.Clear
 
Select Case ComboBox1.ListIndex
    Case 0
        With ComboBox2
            .AddItem "Individual Adults"
            .AddItem "Teens"
            .AddItem "Corporates"
        End With
    Case 1
        With ComboBox2
            .AddItem "Individual Adults"
            .AddItem "Teens"
            .AddItem "Kids"
            .AddItem "Corporates"
        End With
    Case 2
        With ComboBox2
            .AddItem "X Course Deposit Paying"
            .AddItem "X Course Booking"
            .AddItem "Payment Posting (for Any Reason)"
            .AddItem "Getting Copy of the Booking Confirmation"
            .AddItem "Getting Copy of the Payment Receipt"
        End With
End Select
 
End Sub
 
 
 
 
Private Sub ComboBox2_Change()
 
ComboBox3.Clear
 
Select Case ComboBox1.ListIndex * 1000 + ComboBox2.ListIndex
    Case 0
        With ComboBox3
            .AddItem "Reservation"
            .AddItem "Booking"
        End With
    Case 1
        With ComboBox3
            .AddItem "Reservation"
            .AddItem "Booking"
        End With
    Case 2
        With ComboBox3
            .AddItem "Single Reservation"
            .AddItem "Multiple Reservation"
            .AddItem "Single Booking"
        End With
    Case 1000
        With ComboBox3
            .AddItem "Reservation"
            .AddItem "Booking"
            .AddItem "Waiting List"
        End With
    Case 1001
        With ComboBox3
            .AddItem "Reservation"
            .AddItem "Booking"
            .AddItem "Waiting List"
        End With
    Case 1002
        With ComboBox3
            .AddItem "Reservation"
            .AddItem "Booking"
            .AddItem "Waiting List"
        End With
    Case 1003
        With ComboBox3
            .AddItem "Reservation"
            .AddItem "Booking"
            .AddItem "Waiting List"
        End With
End Select
 
End Sub
 
 
 
 
Private Sub ComboBox3_Change()
 
ComboBox4.Clear
 
Select Case ComboBox1.ListIndex * 1000 + ComboBox2.ListIndex * 1000 + ComboBox3.ListIndex
    Case 0
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 1
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "(By Credit Redemption) Confirmation"
            .AddItem "For Young Learner for IELTS Preparation Course Confirmation"
            .AddItem "Cancellation"
            .AddItem "Cancellation (with Lost Payment Receipt)"
            .AddItem "Cancellation (after Credit Redemption)"
            .AddItem "Changing or Taking Recommended B or C Tests"
        End With
    Case 1000
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 1001
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "(By Credit Redemption) Confirmation"
            .AddItem "Cancellation"
            .AddItem "Cancellation (with Lost Payment Receipt)"
            .AddItem "Cancellation (after Credit Redemption)"
            .AddItem "Changing"
        End With
    Case 2000
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 2001
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 2002
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing or Taking Recommended B or C Tests"
        End With
    Case 3000
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 3001
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Confirmation (Academic Writing or IELTS Preparation)"
            .AddItem "Confirmation (by Credit Redemption)"
            .AddItem "Confirmation (by Credit Redemption) (Academic Writing or IELTS Preparation)"
            .AddItem "Cancellation (before Term Start)"
            .AddItem "Cancellation (before Term Start) by 3rd Party"
            .AddItem "Cancellation (before Term Start) (with Lost Payment Receipt)"
            .AddItem "Cancellation (before Term Start) (with Lost Payment Receipt) by 3rd Party"
            .AddItem "Cancellation (before Term Start) (after Credit Redemption)"
            .AddItem "Cancellation (before Term Start) (after Credit Redemption) by 3rd Party"
            .AddItem "Cancellation (after Term Start)"
            .AddItem "Cancellation (after Term Start) by 3rd Party"
            .AddItem "Cancellation (after Term Start) (with Lost Payment Receipt)"
            .AddItem "Cancellation (after Term Start) (with Lost Payment Receipt) by 3rd Party"
            .AddItem "Cancellation (after Term Start) (after Credit Redemption)"
            .AddItem "Cancellation (after Term Start) (after Credit Redemption) by 3rd Party"
            .AddItem "Changing (before the end of 2nd Lecture)"
            .AddItem "Changing (before the end of 2nd Lecture) by 3rd Party"
            .AddItem "Changing (after the end of 2nd Lecture)"
            .AddItem "Changing (after the end of 2nd Lecture) by 3rd Party"
        End With
    Case 3002
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 4000
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 4001
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Confirmation (by Credit Redemption)"
            .AddItem "Cancellation (before Term Start)"
            .AddItem "Cancellation (before Term Start) by 3rd Party"
            .AddItem "Cancellation (before Term Start) (with Lost Payment Receipt)"
            .AddItem "Cancellation (before Term Start) (with Lost Payment Receipt) by 3rd Party"
            .AddItem "Cancellation (before Term Start) (after Credit Redemption)"
            .AddItem "Cancellation (before Term Start) (after Credit Redemption) by 3rd Party"
            .AddItem "Cancellation (after Term Start)"
            .AddItem "Cancellation (after Term Start) by 3rd Party"
            .AddItem "Cancellation (after Term Start) (with Lost Payment Receipt)"
            .AddItem "Cancellation (after Term Start) (with Lost Payment Receipt) by 3rd Party"
            .AddItem "Cancellation (after Term Start) (after Credit Redemption)"
            .AddItem "Cancellation (after Term Start) (after Credit Redemption) by 3rd Party"
            .AddItem "Changing (before the end of 2nd Lecture)"
            .AddItem "Changing (before the end of 2nd Lecture) by 3rd Party"
            .AddItem "Changing (after the end of 2nd Lecture)"
            .AddItem "Changing (after the end of 2nd Lecture) by 3rd Party"
        End With
    Case 4002
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 5000
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 5001
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Confirmation (by Credit Redemption)"
            .AddItem "Cancellation (before Term Start)"
            .AddItem "Cancellation (before Term Start) by 3rd Party"
            .AddItem "Cancellation (before Term Start) (with Lost Payment Receipt)"
            .AddItem "Cancellation (before Term Start) (with Lost Payment Receipt) by 3rd Party"
            .AddItem "Cancellation (before Term Start) (after Credit Redemption)"
            .AddItem "Cancellation (before Term Start) (after Credit Redemption) by 3rd Party"
            .AddItem "Cancellation (after Term Start)"
            .AddItem "Cancellation (after Term Start) by 3rd Party"
            .AddItem "Cancellation (after Term Start) (with Lost Payment Receipt)"
            .AddItem "Cancellation (after Term Start) (with Lost Payment Receipt) by 3rd Party"
            .AddItem "Cancellation (after Term Start) (after Credit Redemption)"
            .AddItem "Cancellation (after Term Start) (after Credit Redemption) by 3rd Party"
            .AddItem "Changing (before the end of 2nd Lecture)"
            .AddItem "Changing (before the end of 2nd Lecture) by 3rd Party"
            .AddItem "Changing (after the end of 2nd Lecture)"
            .AddItem "Changing (after the end of 2nd Lecture) by 3rd Party"
        End With
    Case 5002
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 6000
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
    Case 6001
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation (before Term Start)"
            .AddItem "Changing (before the end of 2nd Lecture)"
            .AddItem "Changing (After the end of 2nd Lecture)"
        End With
    Case 6002
        With ComboBox4
            .AddItem "Confirmation"
            .AddItem "Cancellation"
            .AddItem "Changing"
        End With
 
End Select
 
End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
Your initial problem is with Combobox2 (witch can be written like)
Code: 
Private Sub ComboBox2_Change()
 
ComboBox3.Clear
 
Select Case ComboBox1.ListIndex * 1000 + ComboBox2.ListIndex
    Case 0, 1
        With ComboBox3
            .AddItem "Reservation"
            .AddItem "Booking"
        End With
    Case 2
        With ComboBox3
            .AddItem "Single Reservation"
            .AddItem "Multiple Reservation"
            .AddItem "Single Booking"
        End With
    Case 1000 To 1003
        With ComboBox3
            .AddItem "Reservation"
            .AddItem "Booking"
            .AddItem "Waiting List"
        End With
End Select
 
End Sub
As Cbox1 has 3 items, if the 3rd item is selected this line
Code: 
Select Case ComboBox1.ListIndex * 1000 + ComboBox2.ListIndex
will give you a value of 2000+, which you haven't accounted for.
 
Upvote 0
You mean mistake with ComboBox3 then

Well, I've proceeded with your suggested adjustments anyways

I'm afraid that the same issue still persists

It doesn't match properly when it comes to ComboBox4 starting from "Courses / Adults / Booking" selection
 
Upvote 0
You mean mistake with ComboBox3
Click to expand...
No, I mean the initial mistake is with Cbox 2.
If you select "Miscellaneous" in Cbox1 (which is index 2), when you change Cbox 2 this line
Code: 
Select Case ComboBox1.ListIndex * 1000 + ComboBox2.ListIndex
is saying 2*1000 +Cbox2 ie 2000 & something, but your code only deals with 1000 & something.
 
Upvote 0
Well, this's for the fact that the purpose here is that after selecting "Miscellaneous", ComboBox2 should give 5 options yes, but there'll be no further options to choose from ComBox3 in this case. Basically, ComboBox3 & ComboBox4 are here for the rest of the options, but not for this case which stops at ComboBox2
 
Upvote 0
In that case your code seems to work for me, what is not working?
If you are happy using the list from your similar thread on Ozgrid, you could use this code instead
Code: 
Option Explicit
Dim Dic As Object

Private Sub UserForm_Initialize()

   Dim Cl As Range
   Dim v1 As String, v2 As String, v3 As String, v4 As String

   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = vbTextCompare
   With Sheets("Lists")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         v1 = Cl.Value: v2 = Cl.Offset(, 1).Value: v3 = Cl.Offset(, 2).Value: v4 = Cl.Offset(, 3).Value
         If Not Dic.exists(v1) Then
            Dic.Add v1, CreateObject("scripting.dictionary")
            Dic(v1).Add v2, CreateObject("scripting.dictionary")
            Dic(v1)(v2).Add v3, CreateObject("scripting.dictionary")
            Dic(v1)(v2)(v3).Add v4, Nothing
         ElseIf Not Dic(v1).exists(v2) Then
            Dic(v1).Add v2, CreateObject("scripting.dictionary")
            Dic(v1)(v2).Add v3, CreateObject("scripting.dictionary")
            Dic(v1)(v2)(v3).Add v4, Nothing
         ElseIf Not Dic(v1)(v2).exists(v3) Then
            Dic(v1)(v2).Add v3, CreateObject("scripting.dictionary")
            Dic(v1)(v2)(v3).Add v4, Nothing
         ElseIf Not Dic(v1)(v2)(v3).exists(v4) Then
            Dic(v1)(v2)(v3).Add v4, Nothing
         End If
      Next Cl
   End With
   ComboBox1.List = Dic.keys
   
End Sub
Private Sub ComboBox1_AfterUpdate()
   ComboBox2.Clear
   ComboBox2.List = Dic(ComboBox1.Value).keys
End Sub
Private Sub ComboBox2_AfterUpdate()
   ComboBox3.Clear
   ComboBox3.List = Dic(ComboBox1.Value)(ComboBox2.Value).keys
End Sub
Private Sub ComboBox3_AfterUpdate()
   ComboBox4.Clear
   ComboBox4.List = Dic(ComboBox1.Value)(ComboBox2.Value)(ComboBox3.Value).keys
End Sub
Test file is here https://1drv.ms/x/s!AtYrlcV2NWPFgQ65c22ryuUWU5S-
 
Upvote 0
The project has been solved in Ozgrid but depending on assisting sheets to let the ComBoxes read their values from it.

I'm seeking for simpler solution, by using VBA to apply the values for ComBoxes directly

My code works perfectly till you reach the point selecting (Courses / Individual / Reservation), if you try it you'll get the values of selecting Placement Test / Individual / Reservation), it'll be obvious when selecting for example (Courses Individual / Booking) cause this track later options are totally different, they're kind of 19 sub-options, and they don't appear if you try
 
Upvote 0
If I select Courses / Individual / Reservation, I get Confirmation / Cancellation / Changing
If I select Courses / Kids / Reservation, I get the same output, which is what your code says it should be.
 
Upvote 0
Yeah, because they're identical to Placement Test / Individual / Reservation later options
I tell you what, let us change case 3000 options in the VBA Code itself to be anything else, like A, B, C for instance instead of Confirmation / Cancellation / Changing
Case 3000 is related to this selection Courses / Individual / Reservation
Now you'll see what I'm talking about, starting from this point, it won't work
 
Upvote 0
If I select Courses, Corporate, bookings. I get the selection for Case 4001, which is correct.
That said I have noticed you have Case 5000 and beyond, which is redundant as you can only get a maximum of 4002
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A
M
  • Question Question
3 Dependent Combo Boxes
Replies
6
Views
1K
Magdoulin
M
Oberon70
  • Question Question
Thoughts on how to proceed or accomplish a batch report being created
Replies
0
Views
512
Oberon70
Oberon70
D
  • Question Question
Error '1004' Sort method of range class failed
Replies
0
Views
1K
Davavo
D
V
  • Question Question
To dynamically display Text based on dependent combo box selection on a Button click
Replies
1
Views
1K
Roderick_E
Roderick_E

Forum statistics

Threads
1,223,885
Messages
6,175,182
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top