Activate Combobox dropdown when cell selected, not when doubleclicking

[sirfred33]

CH07.jpgHi there,

I have 4 dropdown lists next to eachother, each activates a combobox when double clicked.

Is there a way to activate the combobox when the cell is just selected with e.g "Tab" or single click?

I tried a private sub with KeyDown in the last part of the code, but this only activates the normal dropdown, not the combobox

Picture of what the sheet looks like is attached

Here is the code:

Private Sub TempCombo_Change()
Range("B9:E9").ClearContents
End Sub




'==========================
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
    If Target.Address = "$A$9" Then
        Set cboTemp = ws.OLEObjects("TempCombo")
        ws.OLEObjects("TempCombo2").Visible = False
    ElseIf Not Application.Intersect(Target, Range("B9:D9")) Is Nothing Then
        Set cboTemp = ws.OLEObjects("TempCombo2")
        ws.OLEObjects("TempCombo").Visible = False
    Else
        Exit Sub
    End If
    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
        cboTemp.DropDown
    End If
errHandler:
    Application.EnableEvents = True
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

Thank you for the help!

[jonh]

Use the selectionchange event?
e.g.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Select Case Target.Address
    Case "$A$1"
        cbo1.DropDown
    Case "$B$2"
        cbo2.DropDown
    Case "$C$3"
        cbo3.DropDown
    End Select
End Sub

[balingao]

Hi there, can you post sample of your work? Im newbie and not yet knowledgeable to VBA codes. Thanks

CH07.jpgHi there,

I have 4 dropdown lists next to eachother, each activates a combobox when double clicked.

Is there a way to activate the combobox when the cell is just selected with e.g "Tab" or single click?

I tried a private sub with KeyDown in the last part of the code, but this only activates the normal dropdown, not the combobox

Picture of what the sheet looks like is attached

Here is the code:

Private Sub TempCombo_Change()
Range("B9:E9").ClearContents
End Sub




'==========================
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
    If Target.Address = "$A$9" Then
        Set cboTemp = ws.OLEObjects("TempCombo")
        ws.OLEObjects("TempCombo2").Visible = False
    ElseIf Not Application.Intersect(Target, Range("B9:D9")) Is Nothing Then
        Set cboTemp = ws.OLEObjects("TempCombo2")
        ws.OLEObjects("TempCombo").Visible = False
    Else
        Exit Sub
    End If
    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
        cboTemp.DropDown
    End If
errHandler:
    Application.EnableEvents = True
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

Thank you for the help!

[SamT]

I think Sir Fred and Jonh are long gone.

Please start a new thread with your questions.

I see that you don't have enough posts to place links in your threads, so please reference this partial link in your new thread,

www.vbaexpress.com/forum/showthread.php?52053

Thanks,
SamT
Moderator