Activate DropDown List and Calendar when Cell Selected

[TRLOS]

Its been many many years since I've done VB Scripting, so I apologize if this is a simple noob question.

I have created a type of form on Excel which will be used on a touch screen tablet.
I need 2 VBA scripts please.

I have used 2 worksheets. The first is the main form. The second worksheet is where I have a bunch of Data Values which are used in Data Validation Drop Down boxes.

Script 1 :
I have created a Drop Down List in Cell F16. At current, when you select F16, I can see the small arrow to the right of the cell so when you click on it, it pulls the Drop Down box down so you can select a value.

My question is, what is the VBA script so that when I select that particular cell, it opens the Drop Down list automatically (ALT+Down Arrow) ?
Can you make it that you can use the same script for the following 10 cells below the first one ?

I have found a similar code but have no idea how to change it to do what I want

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

       If Target.Address = "$A$1" Then
         (What goes here to automatically open the Drop Down Box......ALT+Down Arrow.....)
       End If
    
     End Sub

(Is this the right script or is there another better suited?)

Script 2 :
I have created a Date Picker Calendar (the same as specified on this site 'fontstuff.com/excel/exltut03.htm)
I have added the following in VBA so that it inserts the Selected Date in the Highlighted Cell

Private Sub DTPicker1_Change()
    ActiveCell.Value = Me.DTPicker1.Value
End Sub

Is there a way to automatically open the Date Picker when any cell from J16 - M38 is selected ?


The reason I want these scripts is because this Excel sheet will primarily be used on a touch screen, so would make it easier to use by Single-Tapping on the cell and have it automatically open the relevant areas (Drop Down Box & Date Picker)

Any help would be greatly appreciated.

Thanks in Advance

[TRLOS]

SOLUTION for Script 1

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If Target.Column = 9 And (Target.Row >= 16 And Target.Row <= 38) Then
        SendKeys "%{DOWN}"
    End If
End Sub

Still need help with Script 2

[SamT]

TRLOS,

Welcome to VBA Express.

I changed the Thread Title to better describe your questions. I hope that helps.

[Kenneth Hobs]

When using Sendkeys() for Vista+, be sure to disable UAC.

For the 2nd part, I have not had time to fix the error when you close the dropdown by ESC key. Otherwise, create your Calendar control as explained in that link, and then:
In a Module:

Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long

In the worksheet with the control:

' http://fontstuff.com/excel/exltut03.htm
' http://msdn.microsoft.com/en-us/library/aa231249%28v=vs.60%29.aspx
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim r As Range, t As Long, l As Long
  Set r = Intersect(Target, Range("J16:M38"))
  If r Is Nothing Then Exit Sub
  If r.Cells.Count > 1 Then Exit Sub
  
  With DTPicker1
    t = .Top
    .Top = r.Top
    l = .Left
    .Left = r.Left
    .Activate
    DoEvents
    Application.Wait Now() + TimeSerial(0, 0, 2)
    SetFocus .hwnd
    SendKeys ("{F4}"), True
    DoEvents
    r.Value = .Value
    r.Select
    .Top = t
    .Left = l
  End With
End Sub

[TRLOS]

Just an idea on the error message when you press ESC, Can you add an "On Error Resume Next" somewhere ? Just to avoid the Debug screen from coming up and letting it continue working.

[Kenneth Hobs]

No. I suspect that an API routine would be needed to check for that keypress. I don't have time to code that right now. Maybe I can this weekend if you still need it.