Data Validation and Combo Box with Named Ranges

[DMurray3]

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:

• 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.

'==========================
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
'====================================

 

[sunnyland]

You need to add 2 Lines to add to original code - not yours.
See ***** in the corrected code

The following line check if the target is within the range b4:c4,if so the code run

If Not Intersect(Target, Target, Range("b4:c4")) Is Nothing Then

at the end of the beforDoubleClick

end if

The following corrected code will only display the combo on B4 or C4 of sheet1

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
  Cancel As Boolean)
'************************************
  If Not Intersect(Target, Target, Range("b4:c4")) Is Nothing Then
 '******************************************************    
  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
  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
'====================================

 

[DMurray3]

Thank you very much sunnyland/Francoise....

Sorry if the next question is considered double threading...

A final question on the syntax of "If Not Intersect(Target, Target, Range("b4:c4")) Is Nothing Then" ...

If I had more than 2 cells I would like to apply this validation (...lets say 4 cells...) would it be correct to use:

-if continous cells (for example cells b4, c4, b5, c5):
"If Not Intersect(Target, Target, Target, Target, Range("b4:c5")) Is Nothing Then..."

(ie, one "Target," for each cell?)

-if non-continous cells:
"If Not Intersect(Target, Target, Target, Target, Range("b4; c6; d8; :c4")) Is Nothing Then..."

Many thanks for your guidance and support.

Kind regards.

 

[DMurray3]

Hi sunnyland / Francoise...

Sorry for double-replying...

Again, thank you for the corrected code; it works fine on the sample worksheet we were discussing (ie. taken from www.contextures.com...); I tested changing different cells and they all work!!

However in my "real" scenario, when applying the same code, the combox box´s drop drown for the "second" field/cell, is not showing the list of validated data.



The cells/fields where my DataValidation Combo Boxes are to be used are on sheet FVIngreso!H3 and FVIngreso!H5. The Combo Box is working for the first cell/field (H3), but is remains blank when in the second field/cell (H5).

I would very much appreciate your review and suggestions.

Many thanks

 

[sunnyland]

Apologies for the typo, target should have only appeared once as it is the parameter of the sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Corrected code to be placed on your FVIngreso worksheet:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
  Cancel As Boolean)
'************************************
If Not Intersect(Target,  Range("H3,H5")) Is Nothing Then
 '******************************************************

Not really good at explanations, but going to give it a go:

The word Target was used only because the sub Worksheet_BeforeDoubleClick uses Target as parameter.[cancel is the other parameter]

What the function intersect does is it compares 2 or more ranges and return the common cell(s) to all ranges.
May be a picture gives a clear idea:
https://www.dropbox.com/s/22lmhlitozipuhg/intersect.jpg

The function return a range and if no common cells are found it will return nothing. This is why we test for:

if not intersect(target,range("a1:a2")) is nothing then

If you wanted to have some action on clicking on other cells you will do as follow

If not intersect(target, range("a1:a3,b6:d20,d40")) is nothing then

meaning if target/click is :
in A1 to A3
or in B6:D20
or in D40 your code will run

if you want to test when more than 2 group of range you can also use intersect in your own sub or function.

if not intersect(range1,range2,range3) is nothing then

I hope I haven't confused you more and more then anything hope I haven't written anything incorrect.


Francoise

 

[DMurray3]

Thanks Francoise... Fully understood the logic.

the only problem i have is that the combo box on the 2nd cell is not displaying the data list of the 2nd cell's data validation.

any idea why this could be happening ?

thank you for your troubles..

 

[sunnyland]

Sorry I haven't reply sooner.

To be frank, not quite sure why the code you have is not working as expected. One thing for sure is because there is the line: on error resume next, if an error occurs, the code continue to run so it is difficult to see why it is not behaving properly. Something else as well is when you don't have all data used in front of you it is difficult to test what is going wrong. And last thing is I am not an experience programmer: I enjoy it as a hobby.

Anyway, I have posted my own code at:

https://www.dropbox.com/s/368ofjbf79nisi1/Data Validation and Combo Box with Named Ranges.xlsm

on first sheet is your code previously mentioned. It seems to work with me apart that is something not in the list is entered , the code let it through. May be you can see if it works for you too and if your data are kind of similar.

on sheet francoise, I put my own code, I don't use on error resume next and the code test for valid entry in combo. I couldn't think of all case of figures where things can go wrong so depending what you do , it may generate an error but this is for testing purpose.

Hope it works this way. Please let me know.