Excel 2010 VBA Code to Open a Drop Down List

Hotmail · Jul 6, 2014

I'm trying to create a worksheet that will allow for minimal user input (mouse clicks and keyboard interaction). I have cobbled together the start of what I need based on what I've already found in the forum. The first is to enter a time stamp into a cell (within a range in column A) when it's double-clicked, then move to the adjacent cell in column B. In the cells in column B I have a data validation list. So the second thing I want to happen is to automatically expand the drop down list in the column B cell so my user can simply select a choice that's shown. And then the third and final thing I'm wanting to happen is that after the selection is made for column B I want the cell selection to move to the right again, to the adjacent cell in column C.

So this for example... user double-clicks A2 and the time is entered, then B2 is automatically selected and shows a data validation drop down list, the user selects a choice, and then is automatically taken to C2.

I was able to get the date in column A and then move to column B using this code.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Dim rng As Range
Set rng = Range("TimeEntry")
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, rng) Is Nothing Then
    With Target
            .Value = Time
            .Offset(0, 1).Activate
    End With
End If
End Sub

And I was able to make my data validation drop down list appear when I "manually" selected a specified cell by clicking on it by using this code.

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Err1:
    If Target = Range("B10") Then
        Application.SendKeys ("%{UP}")
    End If
Err1:
    do nothing
End Sub

Since I don't want manually select a cell (by clicking it) I figured I could plug the "SendKeys" line under the ".Offset(0, 1).Activate" line in the time stamp code. When I test it I think I can see the drop down list flash on the screen, but it doesn't stay so the selection can be made. Any thoughts on how to fix this? Or is there a more efficient way to accomplish this? Thanks!

GTO · Jul 6, 2014

Cheesy, but maybe a start...

I just checked against Column A for the double-click, adjust to suit...

Option Explicit Private InProcess As Boolean Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column * Target.Count = 1 Then Cancel = True Target.Value = Time DoEvents InProcess = True Target.Offset(, 1).Select End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim StartTimer As Single If InProcess Then InProcess = False If Timer < 86399 Then StartTimer = Timer Do While StartTimer + 0.1 > Timer DoEvents Loop Application.SendKeys "%{UP}" End If End If End Sub

Mark

Hotmail · Jul 6, 2014

@GTO, great start and seems to work without any issues. Thanks for your help.

Now I need to figure out how to get to column C after selecting an entry from the drop down list. If I can get it figured out I'll post it here. If you or anyone else has any thoughts on it please feel free to advise.

Hotmail · Jul 6, 2014

So here's the updated code (third Sub). It works - for the first row of data, as it specifies the cell. In this case B2. Subsequent cells work find for the date and drop down list, but after selecting from the drop down list it doesn't take me to the adjacent cell in column C.

I've tried variations so that "B2" in the last Sub is not specific. But one of two things is happening. Either the second Sub stops working giving me the drop down list, or it actually takes the active cell to the right by about 70 cells instead of just 1 cell I'm looking for. Any other thoughts?

Code:

Option Explicit
  
Private InProcess As Boolean
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  
  If Target.Column * Target.Count = 1 Then
    Cancel = True
    Target.Value = Time
    DoEvents
    InProcess = True
    Target.Offset(, 1).Select
  End If
  
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim StartTimer As Single
  
  If InProcess Then
    InProcess = False
    If Timer < 86399 Then
      StartTimer = Timer
      Do While StartTimer + 0.1 > Timer
        DoEvents
      Loop
      Application.SendKeys "%{UP}"
    End If
  End If


End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range


Set rng = Range("B2")
    If Target.Count > 2 Then Exit Sub
    If Intersect(Target, rng) Is Nothing Then Exit Sub
        Target.Offset(, 1).Select
On Error GoTo StopIt
    Sheets(1).Name = rng.Value
StopIt: Exit Sub


End Sub

Thanks in advance.

Hotmail · Jul 7, 2014

I figured it out. Did a little reading on the Range Object and found a simple solution - just syntax I guess. Not sure if it's elegant from a programming efficiency standpoint, but it works.

Basically just changed the Range line in the 3rd Sub to specify the column instead of a cell.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

Set rng = Range("B:B") 'This is the changed entry...
    If Target.Count > 2 Then Exit Sub
    If Intersect(Target, rng) Is Nothing Then Exit Sub
        Target.Offset(, 1).Select
On Error GoTo StopIt
StopIt: Exit Sub

End Sub

Hope this might help someone in the future.

Galaxea · Jul 20, 2018

Hotmail said:
I figured it out. Did a little reading on the Range Object and found a simple solution - just syntax I guess. Not sure if it's elegant from a programming efficiency standpoint, but it works.

Basically just changed the Range line in the 3rd Sub to specify the column instead of a cell.

Code:

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Set rng = Range("B:B") 'This is the changed entry... If Target.Count > 2 Then Exit Sub If Intersect(Target, rng) Is Nothing Then Exit Sub Target.Offset(, 1).Select On Error GoTo StopIt StopIt: Exit Sub End Sub

Hope this might help someone in the future.

I registered just to post that I have fixed your code 4 years later....!

I have made it so that when I Tab off the first cell (A2) it fires the dropdown list in B2, and when selecting from the dropdown it fires the dropdown in the next col (C2), etc.

Many thanks for giving me a start on this. Hope this helps anyone else trying to do the same thing.

Code:

Option Explicit
  
Private InProcess As Boolean
  
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim StartTimer As Single


If Target.Column > 1 Then
    InProcess = False
    If Timer < 86399 Then
      StartTimer = Timer
      Do While StartTimer + 0.1 > Timer
        DoEvents
      Loop
      Application.SendKeys "%{UP}"
    End If
  End If




End Sub




Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim StartTimer As Single


    If Target.Column > 1 Then
            Set rng = Range(Split(Cells(1, Target.Column).Address, "$")(1) & ":" & Split(Cells(1, Target.Column).Address, "$")(1))
    
        If Target.Count > 2 Then Exit Sub
        If Intersect(Target, rng) Is Nothing Then Exit Sub
            Target.Offset(, 1).Select
            
        If Timer < 86399 Then
          StartTimer = Timer
          Do While StartTimer + 0.1 > Timer
            DoEvents
          Loop
          Application.SendKeys "%{UP}"
        End If
    
    End If




End Sub

Galaxea · Jul 20, 2018

Galaxea said:
I registered just to post that I have fixed your code 4 years later....!

I have made it so that when I Tab off the first cell (A2) it fires the dropdown list in B2, and when selecting from the dropdown it fires the dropdown in the next col (C2), etc.

Many thanks for giving me a start on this. Hope this helps anyone else trying to do the same thing.

Now fully dynamic. Works on any cell with a dropdown.

Code:

Option ExplicitPublic bDropDownFired As Boolean


  
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim StartTimer As Single


    If HasValidation(Target) Then
        If Timer < 86399 Then
          StartTimer = Timer
          Do While StartTimer + 0.1 > Timer
            DoEvents
          Loop
          Application.SendKeys "%{UP}"
        End If
    End If


End Sub


Function HasValidation(cell As Range) As Boolean
    Dim t: t = Null


    On Error Resume Next
    t = cell.Validation.Type
    On Error GoTo 0


    HasValidation = Not IsNull(t)
End Function


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim StartTimer As Single


    If HasValidation(Target) Then
        Set rng = Range(Split(Cells(1, Target.Column).Address, "$")(1) & ":" & Split(Cells(1, Target.Column).Address, "$")(1))
    
        If Target.Count > 2 Then Exit Sub
        If Intersect(Target, rng) Is Nothing Then Exit Sub
            Target.Offset(, 1).Select
            If HasValidation(Target.Offset(0, 1)) Then
                If Timer < 86399 Then
                  StartTimer = Timer
                  Do While StartTimer + 0.1 > Timer
                    DoEvents
                  Loop
                  Application.SendKeys "%{UP}"
                End If
            End If
    End If


End Sub

realPrincessApril · Jul 12, 2021

@Galaxea your final updated solution was exactly what I was looking for (3 years after your 4-year update, so it wasn't in vain and I just wanted to let you know)!

Thanks!

Galaxea · Jul 12, 2021

@realPrincessApril Amazing. Thanks for letting me know - glad someone else found it useful!

realPrincessApril · Jul 12, 2021

I was able to combine it with a cell clear as well (something I got from another forum). The following will clear the two cells to the right of the updated cell and then go into your code to activate the data-validation drop-down in the first of those two cleared cells (I put a thank you in the code for you with a link to your solution). Thanks again.

VBA Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim StartTimer As Single
    Dim rng As Range

    'Credit for the clear contents solution to warcupine's first response at https://stackoverflow.com/questions/66102263/using-target-offset-to-clear-a-range-of-cells-in-excel/66102311#66102311
    Application.EnableEvents = False
    If Left(Target.Address(, False), 1) = "G" Then ActiveSheet.Range(Target.Offset(, 1), Target.Offset(2, 2)).ClearContents
    Application.EnableEvents = True
    
    'Credit for the activate dropdown solution to Galaxea's updated response at https://www.mrexcel.com/board/threads/excel-2010-vba-code-to-open-a-drop-down-list.789601/post-5108777
    If HasValidation(Target) Then
        Set rng = Range(Split(Cells(1, Target.Column).Address, "$")(1) & ":" & Split(Cells(1, Target.Column).Address, "$")(1))
    
        If Target.Count > 2 Then Exit Sub
        If Intersect(Target, rng) Is Nothing Then Exit Sub
            Target.Offset(, 1).Select
            If HasValidation(Target.Offset(0, 1)) Then
                If Timer < 86399 Then
                  StartTimer = Timer
                  Do While StartTimer + 0.1 > Timer
                    DoEvents
                  Loop
                  Application.SendKeys "%{UP}"
                End If
            End If
    End If
    
End Sub

Excel 2010 VBA Code to Open a Drop Down List

Hotmail

New Member

GTO

MrExcel MVP

Hotmail

New Member

Hotmail

New Member

Hotmail

New Member

Galaxea

New Member

Galaxea

New Member

realPrincessApril

New Member

Galaxea

New Member

realPrincessApril

New Member

Similar threads

Share this page

Excel 2010 VBA Code to Open a Drop Down List

New Member

MrExcel MVP

New Member

New Member

New Member

New Member

New Member

New Member

New Member

New Member

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock