Dependant Dropdown lists using Combo Boxes

L

Lynda

I am using Forms control Combo Boxes in 2003. I am trying to create 3
dependant dropdown lists.
Everything works fine for the (dd1) A1 section but when I go to A2, A3, and
A4 it returns the appropriate results for (dd2) but when it comes to (dd3) it
keeps returning the results connected to A1.
Based on that code below you will find that if you select A4 in dd1, then
B12 in dd2 you will get C3:C14 instead of C52:C55. You can format it to
select C52:C55 but then when you move to another selection and then you come
back to A4, B12 it has gone back to C3:C14

(dd1) (dd2) (dd3)

A1 B1 C1:C2
B2 C3:C14
B3 C15:C18
B4 C19:C24
B5 C25:C33

A2 B6 C34:C34

A3 B7 C35:C35
B8 C36:C40
B9 C41:C45
B10 C46:C50

A4 B11 C51:C51
B12 C52:C55
B13 C56:C66



Below is the code I have been using, kindly written for me by Dave Peterson.

Option Explicit
Sub DD1Change()
Dim DD1 As DropDown
Dim DD2 As DropDown
Dim DD3 As DropDown
Dim myRng2 As Range

Set DD1 = ActiveSheet.DropDowns(Application.Caller)
Set DD2 = ActiveSheet.DropDowns("Drop down 2")
Set DD3 = ActiveSheet.DropDowns("Drop down 3")

With DD1
Set myRng2 = Nothing
Select Case .ListIndex
Case Is = 1: Set myRng2 = Worksheets("sheet2").Range("B1:B5")
Case Is = 2: Set myRng2 = Worksheets("sheet2").Range("B6:B6")
Case Is = 3: Set myRng2 = Worksheets("sheet2").Range("B7:B10")
Case Is = 4: Set myRng2 = Worksheets("sheet2").Range("B11:B13")
End Select
End With

If myRng2 Is Nothing Then
MsgBox "Design error!!!!"
Else
DD2.ListFillRange = myRng2.Address(external:=True)
DD2.ListIndex = 0
DD3.ListFillRange = ""
End If

End Sub
Sub DD2Change()
Dim DD2 As DropDown
Dim DD3 As DropDown
Dim myRng3 As Range

Set DD2 = ActiveSheet.DropDowns(Application.Caller)
Set DD3 = ActiveSheet.DropDowns("Drop down 3")

With DD2
Set myRng3 = Nothing
Select Case .ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C1:C2")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C3:C14")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C15:C18")
Case Is = 4: Set myRng3 = Worksheets("sheet2").Range("C19:C24")
Case Is = 5: Set myRng3 = Worksheets("sheet2").Range("C25:C33")
Case Is = 6: Set myRng3 = Worksheets("sheet2").Range("C34:C34")
Case Is = 7: Set myRng3 = Worksheets("sheet2").Range("C35:C35")
Case Is = 8: Set myRng3 = Worksheets("sheet2").Range("C36:C40")
Case Is = 9: Set myRng3 = Worksheets("sheet2").Range("C41:C45")
Case Is = 10: Set myRng3 = Worksheets("sheet2").Range("C46:C50")
Case Is = 11: Set myRng3 = Worksheets("sheet2").Range("C51:C51")
Case Is = 12: Set myRng3 = Worksheets("sheet2").Range("C52:C55")
Case Is = 13: Set myRng3 = Worksheets("sheet2").Range("C56:C66")
End Select
End With

If myRng3 Is Nothing Then
MsgBox "Design error!!!!"
Else
DD3.ListFillRange = myRng3.Address(external:=True)
DD3.ListIndex = 0
End If

End Sub



Thank you to anyone who can help me with this. Dave Peterson has been
terrific and very patient with me but I must be missing something because I
can’t get the A2, A3 and A4 parts to work.

Cheers
Lynda
 
D

Dave Peterson

You didn't respond (good or bad) to the other thread.

I see the problem. Since the range for dd3 depends on both the value of dd1 and
dd2, you can do something like:

Sub DD2Change()
Dim DD1 As DropDown
Dim DD2 As DropDown
Dim DD3 As DropDown
Dim myRng3 As Range

Set DD1 = ActiveSheet.DropDowns("Drop down 1")
Set DD2 = ActiveSheet.DropDowns(Application.Caller)
Set DD3 = ActiveSheet.DropDowns("Drop down 3")

Set myRng3 = Nothing

Select Case DD1.ListIndex
Case Is = 1
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C1:C2")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C3:C4")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C15:C18")
Case Is = 4: Set myRng3 = Worksheets("sheet2").Range("C19:C24")
Case Is = 5: Set myRng3 = Worksheets("sheet2").Range("C25:C33")
End Select

Case Is = 2
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C34:C34")
End Select

Case Is = 3
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C36:C40")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C41:C45")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C45:C50")
End Select

'ad so forth
End Select

If myRng3 Is Nothing Then
MsgBox "Design error!!!!"
Else
DD3.ListFillRange = myRng3.Address(external:=True)
DD3.ListIndex = 0
End If

End Sub
 
L

Lynda

Hi Dave,

I’m sorry for not responding to the previous post but I was taking your
suggestion of posting to the general population. As you could probably tell I
was still having no luck and thankfully you picked up on it again (you were
the only one). Now I am getting 2 errors the first is ‘can’t operate in break
mode‘, I think (although I’m not sure) that I have worked it out. The second
is ‘select case without end select’.

When I get there, do I still add the macros to dd1 and dd2 or has that
changed?

I’m sorry I can’t respond on a more timely basis as we are not allowed to
have access to the discussion forum at work because it is considered a chat
room, so I have to wait until I get home of an evening before I can contact
you people, although I'm at home today. Very frustrating, although it appears
night time for me is better to get you people because of the time difference
and unfortunately I am often asleep by the time you have responded so I have
to do the full 24 hour cycle and by then my query has well and truly dropped
down the list and I don’t know if you VIP’s look back any further than the
first page.
 
D

Dave Peterson

I was surprised that I didn't see a "I"m going to close this thread and start a
new one" notice. But that's not important <vbg>.

Make sure you stop any macro that's running before clicking on either dropdown
that starts another macro.

And I'm not sure if the indentation is lost when you post to the newsgroup, but
if you're not indenting your code, try that.

Lots of times, you'll see the missing "end if", "end select", ... easier.
 
L

Lynda

Back again Dave, I checked all the indents and they are the same as you have
written and i am still getting the same errors. I am so determined to work
this out (well, you are doing all the work) because of all the time you have
put in but at the same time i just feel like giving up mainly because i don't
understand it all enough and it just frustrates me so much. I love what code
can do i just hate it that i am not smart enough to know how to write it.

I apologise for not having closed off the previous thread, i guess i also
need to learn the protocol of using this site. I just think you guys are
great and so patient with novices like me that usually by the time i get here
i am pulling my hair out.

I know i am probably stepping outside the boundry of the forum by asking
this but would you send me your test page by email to the address below so i
can see what it is i am doing wrong otherwise please advise me via the forum
of your response. (e-mail address removed)

Thank you
Cheers
Lynda
 
D

Dave Peterson

I like to keep the discussions in the newsgroup.

How about pasting your current code in the next reply?
Back again Dave, I checked all the indents and they are the same as you have
written and i am still getting the same errors. I am so determined to work
this out (well, you are doing all the work) because of all the time you have
put in but at the same time i just feel like giving up mainly because i don't
understand it all enough and it just frustrates me so much. I love what code
can do i just hate it that i am not smart enough to know how to write it.

I apologise for not having closed off the previous thread, i guess i also
need to learn the protocol of using this site. I just think you guys are
great and so patient with novices like me that usually by the time i get here
i am pulling my hair out.

I know i am probably stepping outside the boundry of the forum by asking
this but would you send me your test page by email to the address below so i
can see what it is i am doing wrong otherwise please advise me via the forum
of your response. (e-mail address removed)

Thank you
Cheers
Lynda
 
L

Lynda

Hi Dave, thank you for your response, i respect your wishes.

Here is the code you requested. Which dropdown/s do i attach the macro to
now with this new code once it's working.

Sub DD2Change()
Dim DD1 As DropDown
Dim DD2 As DropDown
Dim DD3 As DropDown
Dim myRng3 As Range

Set DD1 = ActiveSheet.DropDowns("Drop down 1")
Set DD2 = ActiveSheet.DropDowns(Application.Caller)
Set DD3 = ActiveSheet.DropDowns("Drop down 3")

Set myRng3 = Nothing

Select Case DD1.ListIndex
Case Is = 1
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C1:C2")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C3:C14")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C15:C18")
Case Is = 4: Set myRng3 = Worksheets("sheet2").Range("C19:C24")
Case Is = 5: Set myRng3 = Worksheets("sheet2").Range("C25:C33")
End Select

Case Is = 2
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C34:C34")
End Select

Case Is = 3
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C35:C35")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C36:C40")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C41:C45")
Case Is = 4: Set myRng3 = Worksheets("sheet2").Range("C46:C50")
End Select

Case Is = 4
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C51:C51")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C52:C55")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C56:C66")
End Select

If myRng3 Is Nothing Then
MsgBox "Design error!!!!"
Else
DD3.ListFillRange = myRng3.Address(external:=True)
DD3.ListIndex = 0
End If

End Sub


Cheers
Lynda
 
D

Dave Peterson

You missed the End Select here:

End Select
End Select '<-- added

If myRng3 Is Nothing Then

And this macro should be assigned to the 2nd dropdown (notice the name of the
procedure).

(The code compiles, but I didn't test.)
Hi Dave, thank you for your response, i respect your wishes.

Here is the code you requested. Which dropdown/s do i attach the macro to
now with this new code once it's working.

Sub DD2Change()
Dim DD1 As DropDown
Dim DD2 As DropDown
Dim DD3 As DropDown
Dim myRng3 As Range

Set DD1 = ActiveSheet.DropDowns("Drop down 1")
Set DD2 = ActiveSheet.DropDowns(Application.Caller)
Set DD3 = ActiveSheet.DropDowns("Drop down 3")

Set myRng3 = Nothing

Select Case DD1.ListIndex
Case Is = 1
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C1:C2")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C3:C14")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C15:C18")
Case Is = 4: Set myRng3 = Worksheets("sheet2").Range("C19:C24")
Case Is = 5: Set myRng3 = Worksheets("sheet2").Range("C25:C33")
End Select

Case Is = 2
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C34:C34")
End Select

Case Is = 3
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C35:C35")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C36:C40")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C41:C45")
Case Is = 4: Set myRng3 = Worksheets("sheet2").Range("C46:C50")
End Select

Case Is = 4
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C51:C51")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C52:C55")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C56:C66")
End Select

If myRng3 Is Nothing Then
MsgBox "Design error!!!!"
Else
DD3.ListFillRange = myRng3.Address(external:=True)
DD3.ListIndex = 0
End If

End Sub

Cheers
Lynda
 
L

Lynda

It is not bringing up any errors now but it is still not working in that it
still has the same problem as the one i posted on 10/13/2008 2:09 AM PST.
thanks Dave
Cheers
Lynda
 
D

Dave Peterson

ps.

Tell me what to choose in the first dropdown, the 2nd dropdown.

Then tell me what I see (to double check that I'm doing it right).

And tell me what I should have seen if it had been working ok.
 
L

Lynda

Dave, email sent as requested.

Cheers
Lynda

Dave Peterson said:
ps.

Tell me what to choose in the first dropdown, the 2nd dropdown.

Then tell me what I see (to double check that I'm doing it right).

And tell me what I should have seen if it had been working ok.
 
L

Lynda

LEGEND, LEGEND. LEGEND. THANK YOU, THANK YOU, THANK YOU.

I didn't realise I had to have the extra code at the top.

I am sorry for the 2007 thing, I usually save everything in 97-2003 because
that is what I have at work. Hate 2007, waste too much time trying to find
stuff on the ribbon, feel like a total learner all over again. Seriously
considering reinstalling 2003.

Anyway you have fixed my problem and I am eternally grateful. Can I now say
'This thread is closed'.

Thank you Dave, for your perseverance and patience on this epic journey.

Cheers
Lynda
 
L

Lynda

Here is the code that saved me.


Option Explicit
Sub DD1Change()
Dim DD1 As DropDown
Dim DD2 As DropDown
Dim DD3 As DropDown
Dim myRng2 As Range

'dd1 is the one you changed--no need to assign by name.
Set DD1 = ActiveSheet.DropDowns(Application.Caller)
Set DD2 = ActiveSheet.DropDowns("Drop down 2")
Set DD3 = ActiveSheet.DropDowns("Drop down 3")

With DD1
Set myRng2 = Nothing
Select Case .ListIndex
Case Is = 1: Set myRng2 = Worksheets("sheet2").Range("B1:B5")
Case Is = 2: Set myRng2 = Worksheets("sheet2").Range("B6:B6")
Case Is = 3: Set myRng2 = Worksheets("sheet2").Range("B7:B10")
Case Is = 4: Set myRng2 = Worksheets("sheet2").Range("B11:B13")
End Select
End With

If myRng2 Is Nothing Then
MsgBox "Design error!!!!"
Else
DD2.ListFillRange = myRng2.Address(external:=True)
DD2.ListIndex = 0
'dd3 gets reset to nothing
DD3.ListFillRange = ""
End If

End Sub
Sub DD2Change()
Dim DD1 As DropDown
Dim DD2 As DropDown
Dim DD3 As DropDown
Dim myRng3 As Range

Set DD1 = ActiveSheet.DropDowns("Drop down 1")
Set DD2 = ActiveSheet.DropDowns(Application.Caller)
Set DD3 = ActiveSheet.DropDowns("Drop down 3")

Set myRng3 = Nothing

Select Case DD1.ListIndex
Case Is = 1
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C1:C2")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C3:C14")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C15:C18")
Case Is = 4: Set myRng3 = Worksheets("sheet2").Range("C19:C24")
Case Is = 5: Set myRng3 = Worksheets("sheet2").Range("C25:C33")
End Select

Case Is = 2
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C34:C34")
End Select

Case Is = 3
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C35:C35")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C36:C40")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C41:C45")
Case Is = 4: Set myRng3 = Worksheets("sheet2").Range("C46:C50")
End Select

Case Is = 4
Select Case DD2.ListIndex
Case Is = 1: Set myRng3 = Worksheets("sheet2").Range("C51:C51")
Case Is = 2: Set myRng3 = Worksheets("sheet2").Range("C52:C55")
Case Is = 3: Set myRng3 = Worksheets("sheet2").Range("C56:C66")
End Select
End Select

If myRng3 Is Nothing Then
MsgBox "Design error!!!!"
Else
DD3.ListFillRange = myRng3.Address(external:=True)
DD3.ListIndex = 0
End If

End Sub
 
D

Dave Peterson

Whew!!!

Glad you got it working.
LEGEND, LEGEND. LEGEND. THANK YOU, THANK YOU, THANK YOU.

I didn't realise I had to have the extra code at the top.

I am sorry for the 2007 thing, I usually save everything in 97-2003 because
that is what I have at work. Hate 2007, waste too much time trying to find
stuff on the ribbon, feel like a total learner all over again. Seriously
considering reinstalling 2003.

Anyway you have fixed my problem and I am eternally grateful. Can I now say
'This thread is closed'.

Thank you Dave, for your perseverance and patience on this epic journey.

Cheers
Lynda
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top