Identify Forms DropDown as it is triggered

  • Thread starter Thread starter Darren Hill
  • Start date Start date
D

Darren Hill

I'm not sure how to manipulate the DropDown boxes from the Forms toolbar.
Here's my problem:

I have a set of dropdowns in cells A5:A20.
I have second set of dropdowns in cells B5:B20.

When a selection is made in the Set A dropdowns, I want to change the
listfillrange displayed in the adjacent dropdown in Set B.

I could create a macro linked to each of the dropdowns in column A, but I'm
sure there's a way to have a single macro, and in that macro identify which
row I'm on, and then select the dropdown in column B on the same row.

Thanks in Advance.

Darren
 
You could cycle through all the dropdowns looking at the topleftcell. When it
has the same address as the topleftcell of the one in column A (offset 1 column,
though), you could use that one:

Option Explicit
Sub testme01()

Dim ColA_DD As DropDown
Dim myDD As DropDown

Set ColA_DD = ActiveSheet.DropDowns(Application.Caller)

For Each myDD In ActiveSheet.DropDowns
If myDD.TopLeftCell.Address _
= ColA_DD.TopLeftCell.Offset(0, 1).Address Then
'found it
'MsgBox ColA_DD.List(ColA_DD.ListIndex)
myDD.ListIndex = 0 'empty it
If ColA_DD.ListIndex > 3 Then
myDD.ListFillRange _
= Worksheets("sheet2").Range("a1:a10") _
.Address(external:=True)
Else
myDD.ListFillRange _
= Worksheets("sheet2").Range("b1:b10") _
.Address(external:=True)
End If
Exit For 'Don't look for any more
End If
Next myDD

End Sub

If you named the dropdowns nicely, you could even do it without looping:

Say the dropdowns in column A are named:

Dropdown1, dropdown2, ..., dropdown99

Then name the corresponding dropdowns in column B:
dropdown1B, dropdown2B, ..., dropdown99B

Then you could do something like:

Option Explicit
Sub testme01A()

Dim myDD As DropDown
Dim ColA_DD As DropDown

Set ColA_DD = ActiveSheet.DropDowns(Application.Caller)
Set myDD = ActiveSheet.DropDowns(Application.Caller & "B")

myDD.ListIndex = 0 'empty it
If ColA_DD.ListIndex > 3 Then
myDD.ListFillRange _
= Worksheets("sheet2").Range("a1:a10") _
.Address(external:=True)
Else
myDD.ListFillRange _
= Worksheets("sheet2").Range("b1:b10") _
.Address(external:=True)
End If

End Sub

Either way you do it, right click on each dropdown in A and assign the same
macro to each.
 
Darren
If we assume that the drop downs are consecutively named
ie.
DropDown_A5 to DropDown_A20
and
DropDown_B5 to DropDown_B20

and
DropDown_A5 to DropDown_A20 reference the following macro

Sub ChangeColumnBDropDown()
Dim strCaller As String
Dim strFillRange As String
Dim intLink As Integer

'will return the name of the responsible drop-down
strCaller = Application.Caller()
With ActiveSheet.Shapes(strCaller)
intLink = .ControlFormat.Value
End With

strFillRange = ActiveSheet.Range("I3").Offset(0,
intLink).Resize(8, 1).Address(, , xlA1)

With ActiveSheet.Shapes(Replace(strCaller, "A", "B"))
.ControlFormat.ListFillRange = strFillRange
End With
End Sub


Kevin Beckham
 
You should consider using the equivalent control from the Controls
toolbar i.e. the ActiveX ComboBox control. These controls are
notoriously buggy when used on a worksheet, and rightly so in most
cases, but I've used them extensively and I've never had a problem
with the ComboBox control. The big advantage of using an ActiveX
control is that you can declare one as a WithEvents object variable in
a class module and trap its events. This means that multiple ComboBox
controls can have a common event handler which could test the name of
the ComboBox for that particular instance of the class.
 
Class Modules are a bit of a mystery to me. Can you show me how I would do
that?

Darren
 
Thanks Dave and Kevin - I'm off to try out those methods.
I hadn't actually realised I could rename the dropdowns through the name
box, and these
methods got me to investigate that. So thanks for that too :)

Darren
 
I've posted my amended code below (and I've used bits from both Dave and
Kevin's code, thanks). It all works. :)

Now, my problem is on the Resize line - I need to dynamically resize the
fillrange based on the rows in the current column of the range
"GarmentsByType". They vary from column to column.

How do I change:
ColB_DD.ListFillRange = Worksheets("GarmentsByType"). _
Range("GarmentByType"). _
Resize(8, 1). _
Address(external:=True)

To
ColB_DD.ListFillRange = Worksheets("GarmentsByType"). _
Range("GarmentByType"). _
Resize(xxx, 1). _
Address(external:=True)

where xxx = number of rows of data in current column?

Darren

--------The Full Code-------

Sub ChangeDropDownC()
'From Dave Peterson and Kevin Beckham

Dim ColB_DD As DropDown
Dim ColA_DD As DropDown
Dim strCaller As String
Dim strFillRange As String
Dim intLink As Integer

'will return the name of the responsible drop-down
strCaller = Application.Caller()
With ActiveSheet.Shapes(strCaller)
intLink = .ControlFormat.Value
End With

Set ColA_DD = ActiveSheet.DropDowns(strCaller)
strCaller = Replace(strCaller, "A", "C")
Set ColB_DD = ActiveSheet.DropDowns(strCaller)

If ColB_DD.ListIndex <> 0 Then ColB_DD.ListIndex = 0 'empty it

intLink = Application.WorksheetFunction.Index _
(Range("List_OutfitTypes"), intLink)

If intLink > -1 Then
ColB_DD.ListFillRange =
Worksheets("GarmentsByType").Range("GarmentByType"). _
Offset(0, intLink).Resize(8, 1).Address(external:=True)
Else
ColB_DD.ListFillRange =
Worksheets("GarmentsByType").Range("GarmentByType"). _
Resize(1, 1).Address(external:=True)
End If

ColB_DD.ListIndex = 1


End Sub
 
Just noticed an odd problem with the dropdowns.
The Column C dropdown (it moved from Column B to C for aesthetic reasons)
never shows anything other then "(none)", which is always the top cell of
the list fill range.
I can select a value, and the proper value is entered in the linked cell,
but the text displayed in the drop down box is always "(none)". Any clues as
to why this is?

(The code is repeated below)
Darren
 
I figured out one solution to the resize problem below:

With Worksheets("GarmentsByType").Range("GarmentByType")
ColC_DD.ListFillRange = .Offset(0, intLink).Resize( _
.Offset(0, intLink).End(xlDown).Row - 1, _
1).Address(external:=True)
End With

The key bit is
".Offset(0, intLink).End(xlDown).Row - 1"

Is there another way to achieve the same result, but just finding the last
cell in the current section of data (there might be occupied cells further
down the spreadsheet).
 
I know that once you get an idea, it's difficult to give up on it. (get a
bigger hammer!)

And even though your formula works, I'm not sure I could understand it in a
couple of weeks.

Sometimes it's easier to break it into smaller pieces to do what you want:

Dim myCell As Range
Dim myRng As Range
Dim intLink As Long

intLink = 8 '???

With Worksheets("GarmentsByType").Range("GarmentByType")
Set myCell = .Offset(0, intLink).Resize(1, 1)
Set myRng = Range(myCell, myCell.End(xlDown))
ColC_DD.ListFillRange = myRng.Address(external:=True)
End With

move over that number of columns. (just use the top row (.resize(1,1) bit).

then drop until you find an empty cell (assumes that you have at least two items
in each colunm???).

Debra Dalgleish has some techniques for using dependent lists with
data|validation at:
http://www.contextures.com/xlDataVal02.html

And a way to create a name for a dynamic range at:
http://www.contextures.com/xlNames01.html#Dynamic
 
I just tried recreating a small worksheet with some of your stuff. It worked ok
for me--there was not a problem with the display.

Does it work ok on other pc's?
 
It appeared to be a problem with one dropdown box. Once I deleted that one,
the others worked okay. Bizarre!
I posted an update but put it in another thread - sorry!
 
Your version does look a lot clearer and nicer than mine! I've changed to
that version.

Is there any reason to keep the number of variables down?
I'd be tempted to change what you had to:
Dim myRng As Range
Dim intLink As Long

intLink = 8 '???

With Worksheets("GarmentsByType").Range("GarmentByType")
Set myRng = .Offset(0, intLink).Resize(1, 1)
Set myRng = Range(myRng, myRng.End(xlDown))
ColC_DD.ListFillRange = myRng.Address(external:=True)
End With
Click to expand...

Is there any reason this is a bad idea?

I'm off to check up those references - Debra Dalgleish's site looks like
another one to bookmark. Thanks for the link.
 
For a small demo, carry out the following steps:

Close all other workbooks (just on case something goes wrong!)
Create a new blank workbook (don't forget to save it).
On Sheet1, add some values to range A1:A10.
From the Controls toolbar, add two comboboxes to Sheet1.
By default, they will be called ComboBox1 and ComboBox2 respectively.
Ensure the Control toolbar is not in design mode (the 'setsquare' button).
In the VBE, add a class module to the project (it will be called Class1 by default).
Add the following code to Class1:


Option Explicit

Private WithEvents m_oCombo As MSForms.ComboBox

Public Function InitProperties(ByVal Combo As MSForms.ComboBox, _
ByVal ListFillRange As Range) As Boolean
Set m_oCombo = Combo
Combo.List = ListFillRange.Value
End Function

Private Sub m_oCombo_Change()
MsgBox "You changed " & m_oCombo.Name
End Sub


Add the following code to the code module of Sheet1:


Option Explicit

Private m_oClass1Instance1 As Class1
Private m_oClass1Instance2 As Class1

Public Sub InitializeClasses()

Set m_oClass1Instance1 = New Class1
Set m_oClass1Instance2 = New Class1

m_oClass1Instance1.InitProperties ComboBox1, Me.Range("A1:A10")
m_oClass1Instance2.InitProperties ComboBox2, Me.Range("A1:A10")

End Sub

Public Sub KillClasses()

Set m_oClass1Instance1 = Nothing
Set m_oClass1Instance2 = Nothing

End Sub

Run the InitializeClasses macro.
Dropdown the combos and select a value from each.
Don't forget to run the KillClasses sub before you close the workbook.
 
My rule of thumb is to make it easy to understand. I don't think I'd use yours,
but that would be just a personal preference. If you like it, stick with it.

Well, after deep thought (cough, cough), I think I'd use two variables for this
type thing:

I put "asdf" in a1:a5 in a test worksheet, then ran this code:

Option Explicit
Sub testme02()

Dim myRng As Range
Set myRng = Range("a1")
MsgBox myRng.Address

On Error Resume Next
Set myRng = Range(myRng, _
myRng.End(xlDown)).Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0

if myrng is nothing then
msgbox "nothing"
else
MsgBox myRng.Address
end if

End Sub

Since A1:a5 didn't contain any formulas, I wanted myRng to return nothing.

By using a couple of variables, I could avoid this problem:

Option Explicit
Sub testme02()

Dim myRng As Range
Dim myRngFormulas As Range
Set myRng = Range("a1")
MsgBox myRng.Address

Set myRngFormulas = Nothing
On Error Resume Next
Set myRngFormulas = Range(myRng, _
myRng.End(xlDown)).Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0

If myRngFormulas Is Nothing Then
MsgBox "nothing"
Else
MsgBox myRngFormulas.Address
End If

End Sub

I guess if you're careful, it's ok. But I'm afraid that I won't be that
careful.
 
You said:
I guess if you're careful, it's ok. But I'm afraid that I won't be that
careful.
Click to expand...

Thanks, that answers my question. I am certainly prone to the odd bit of
sloppiness so I'll have to watch out :)

Darren
 
Back
Top