Dear all,
I am not an experienced VBA programmer… I am trying to build on / replicate a Data Validation and Combo Box with Named ranges found at http://www.contextures.com/xlDataVal11.html.
My workbook has three sheets:
In Data(Sheet1), what I need is for the “Data Validation and Combo Box with Named ranges” macro work solely on cells $B$4 and $c$4.
The problem I am having is that while the macro is working correctly for the first cell (Data! $B$4), the second cell’s (Data!$c$4) combox does not appear / work upon double-clicking said cell.
I am enclosing the code I have come up with, and would appreciate if someone could take a look at it and advise what I am doing wrong / missing, or suggest a working example I could study and adjust to my needs.
I apologize for any mistakes in this thread.
Many thanks and kind regards.
I am not an experienced VBA programmer… I am trying to build on / replicate a Data Validation and Combo Box with Named ranges found at http://www.contextures.com/xlDataVal11.html.
My workbook has three sheets:
- Data(Sheet1): with my data validation cells (“Weekday” fields B4:B13; “Month” fields C4:C13)
- Days(Sheet2): with my list of days of the week (“Monday” in B2 up to “Sunday” in B8); this is also the named range “ListDays”
- Months(Sheet3): with my list of months (“January” in B2 up to “December” in B13); this is also the named range “ListMonths”
In Data(Sheet1), what I need is for the “Data Validation and Combo Box with Named ranges” macro work solely on cells $B$4 and $c$4.
The problem I am having is that while the macro is working correctly for the first cell (Data! $B$4), the second cell’s (Data!$c$4) combox does not appear / work upon double-clicking said cell.
I am enclosing the code I have come up with, and would appreciate if someone could take a look at it and advise what I am doing wrong / missing, or suggest a working example I could study and adjust to my needs.
I apologize for any mistakes in this thread.
Many thanks and kind regards.
Code:
'==========================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
'first cell to have Data Validations & ComboBox
If ActiveCell.Address = "$B$4" Then
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Cancel = True
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.TempCombo.DropDown
End If
End If
'second cell to have Data Validations & ComboBox
If ActiveCell.Address = "$c$4" Then
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Cancel = True
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.TempCombo.DropDown
End If
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Application.EnableEvents = False
Application.ScreenUpdating = True
If Application.CutCopyMode Then
'allow copying and pasting on the worksheet
GoTo errHandler
End If
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
'***NOTE: if KeyDown causes problems, change to KeyUp
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Select Case KeyCode
Case 9 'Tab
ActiveCell.Offset(0, 1).Activate
Case 13 'Enter
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub
'====================================