Calendar popup - activate on cell selection

[PatrickW]

Hi, all

I have downloaded the following VBA script to be able to select a date from a calendar, rather than having to type in a date manually.

' ===================================================
' Code by Martin Green    eMail martin@fontstuff.com
' Visit my Office Tips web site at www.fontstuff.com
' ===================================================

Private Sub Workbook_Open()
    Dim NewControl As CommandBarControl
' Assign shortcut to display calendar on SHIFT+CTRL+C
    Application.OnKey "+^{C}", "Module1.OpenCalendar"
' Add item to shortcut menu on open
    On Error Resume Next
    Application.CommandBars("Cell").Controls("Insert Date").Delete
    On Error GoTo 0
    Set NewControl = Application.CommandBars("Cell").Controls.Add
    With NewControl
        .Caption = "Insert Date"
        .OnAction = "Module1.OpenCalendar"
        .BeginGroup = True
    End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Delete item from shortcut menu on close
    On Error Resume Next
    Application.CommandBars("Cell").Controls("Insert Date").Delete
End Sub

At present, the calendar appears when the shortcut key SHIFT+CTRL+C is selected, or from the right-click drop down menu.

I would like the calendar to appear in every cell where below where the text "date" occurs in the first three rows of the column.

E.g., if I have the text "Commencement date" in cell A3, I would like all cells below A3, when selected, to popup this calendar; similarly if I had the text
"Date of termination" in C1, the same should happen to all cells below C1.

What code modification would I require to enable this, please?

I look forward to your answers.

My thanks,

PatrickW

 

[Sandeep Warrier]

Hi

Maybe something like (in the worksheet specific module)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Columns.Count > 1 Then Exit Sub
    If Target.Row = 2 Then Exit Sub 'change to suit the row number that contains "Date"
    If Not Intersect(Range("D:D,F:F,H:H,J:J"), Target) Is Nothing Then 'Change columns to suit the columns containing "Date"
        'Code that brings up the calendar
    End If
End Sub

<input id="gwProxy" type="hidden"><!--Session data--><input *******="jsCall();" id="jsProxy" type="hidden"><input id="gwProxy" type="hidden"><!--Session data--><input *******="jsCall();" id="jsProxy" type="hidden"><input id="gwProxy" type="hidden"><!--Session data--><input *******="jsCall();" id="jsProxy" type="hidden">

 

[PatrickW]

Hi, Sandeep

Thanks for your reply: however, I can't seem to get this approach to work.

The only other piece of code in the VBA script I downloaded was the following:

Sub OpenCalendar()
' Displays the UserForm and calendar
' Shortcuts should be made to this procedure
    frmCalendar.Show
End Sub

saved as a separate module, while the code I supplied previously was saved under 'ThisWorkbook'.

How exactly do you propose I apply this? I've modified the row number and columns I would like this to apply to, but no joy, alas.

I would appreciate your help.

Thanks

PatrickW

 

[Sandeep Warrier]

Hi Patrick,

Try putting the line

frmCalendar.Show

where my code says 'Code that brings up the calendar.
<input id="gwProxy" type="hidden"><!--Session data--><input *******="jsCall();" id="jsProxy" type="hidden">

 

[PatrickW]

Ah - it appears as though I neglected to mention that this was in the form of an add-in, which was why I was struggling to get Sandeep's code to work.

I copied and pasted the code/forms/modules from the add-in into the worksheet itself, and then Sandeep's code ran perfectly.

Thanks for your help, Sandeep

PatrickW