Dependant Dropdown lists using Combo Boxes
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
cant get the A2, A3 and A4 parts to work.
Cheers
Lynda
|