VBA to open a drop down menu, pause and select a value

glad_ir

Board Regular
Joined
Nov 22, 2020
Messages
69
Office Version
  1. 2010
Platform
  1. Windows
Hello,

Please can somebody help me.

I'm trying to create a macro that selects a cell, opens its drop down list, pauses for 1 second (with the list open/visible), then selects an entry from the drop down list. I've used the Application.Wait Now functionality for pausing in between commands before but don't know how to open the drop down menu and select from it with VBA.

So what I'm trying to achieve is....

Select cell A1 and open its drop down menu
Pause for 1 second with the drop down menu open and visible
Select the 2nd entry on the data validation list
Select cell A2

Any help would be much appreciated.

Thanks,
Iain
 

Some videos you may like

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

DeficientOptimism

New Member
Joined
Jan 19, 2021
Messages
12
Office Version
  1. 365
Platform
  1. Windows
This is some code mostly unrelated to what you're doing but it is has something that might be of use.

Where you can see the "Cells(8, 3) = temp" part of the code, this is looking in the target workbook, and essentially going down 8 rows, and going across 3 columns which is the location of data validation cell. Depending on where your data validation list starts, you would change as necessary.

= temp is a variable I have set for the data validation selection. Within the workbook the macro was created I had the data validation list pasted and declared this to be temp and loop through.

This fixed my issue for selecting data validation. If you follow through this code I managed to copy and paste out the relevant clubs by selecting data that was formula driven based on the data validation.

Have a play around with it, I'm sure you can solve it with this.



VBA Code:
Sub Create_Booking_Distribute_File()

Dim wb As Workbook
Dim wb2 As Workbook
Dim wb1 As Workbook
Dim Saveaddress, temp As String
Dim Clublist As Range

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set wb = Workbooks.Open("X:\Finance\Management accounts\2020\Reports\Active Month\Club P&L\P&L for clubs -  February 20.xlsx")

Saveaddress = "X:\Finance\Craig\YTD_February20"

wb1.Activate
Set Clublist = Worksheets("Control").Range("B2:B53")

For Each Club In Clublist

temp = Club

Set wb2 = Workbooks.Add
'wb2.saveAs temp

wb2.Activate

wb2.Sheets("sheet1").Name = "YTD Club P&L"

wb.Sheets("YTD Club P&L").Activate

Cells(8, 3) = temp
With wb.Sheets("YTD Club P&L").Range("A3:F174").Copy
    wb2.Sheets("YTD Club P&L").Range("A1").PasteSpecial xlPasteValues
    wb2.Sheets("YTD Club P&L").Range("A1").PasteSpecial xlPasteFormats
  
  
wb2.Sheets("YTD Club P&L").Activate
   ActiveWindow.DisplayGridlines = False
   Cells.EntireColumn.AutoFit
 
  
End With

wb2.SaveAs Saveaddress & "_" & temp & ".xlsx"

wb2.Close
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,173
Office Version
  1. 2016
Platform
  1. Windows
This is not as easy as it first sounds... Application.Wait as well as Application.OnTime or even DoEvents, they all seem to lock sending the keys to the Data Validation DropDown.
The only way I could make this work is by executing each command inside a seperate Timer Procedure.

Try the following Test SUB :
VBA Code:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If

Private Const KEYEVENTF_KEYUP = &H2
Private Const WM_KEYDOWN = &H100
Private Const VK_DOWN As Long = &H28
Private Const VK_MENU = &H12
Private Const VK_RETURN = &HD
Private Const VK_HOME = &H24

#If Win64 Then
    Private hwnd As LongLong
#Else
    Private hwnd As Long
#End If


Sub Test()
    [a1].Select
    Call Sleep(1000)
    Call keybd_event(VK_MENU, 0, 0, 0)
    Call keybd_event(VK_DOWN, 0, 0, 0)
    Call keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0)
    Call keybd_event(VK_MENU, 0, 0 Or KEYEVENTF_KEYUP, 0)
    Call SetTimer(Application.hwnd, 0, 0, AddressOf TimerProc1)
End Sub

Sub TimerProc1()
    Call KillTimer(Application.hwnd, 0)
    hwnd = FindWindow("EXCEL:", vbNullString)
    If hwnd Then
        Call PostMessage(hwnd, WM_KEYDOWN, VK_HOME, 0)
        Call SetTimer(Application.hwnd, 0, 0, AddressOf TimerProc2)
    End If
End Sub

Sub TimerProc2()
    Call KillTimer(Application.hwnd, 0)
    Call Sleep(1000)
    Call PostMessage(hwnd, WM_KEYDOWN, VK_DOWN, 0)
    Call SetTimer(Application.hwnd, 0, 0, AddressOf TimerProc3)
End Sub

Sub TimerProc3()
    Call KillTimer(Application.hwnd, 0)
    Call Sleep(1000)
    Call PostMessage(hwnd, WM_KEYDOWN, VK_RETURN, 0)
    Call SetTimer(Application.hwnd, 0, 0, AddressOf TimerProc4)
End Sub

Sub TimerProc4()
    Call KillTimer(Application.hwnd, 0)
    Call Sleep(1000)
    [a2].Select
End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,127,387
Messages
5,624,402
Members
416,026
Latest member
melvic69

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top