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

[glad_ir]

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

 

[DeficientOptimism]

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.

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]

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 :

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