Popup Calendar Problem

This function to display the calendar requires that the user hit ESC before a date can be selected. Here is the code:

Sub PopUpCalEntry(cCell As Range)
Dim newDate As String
Load frmCal
newDate = Format(Date, "yyyy-mm-dd")
frmCal.Calendar1.Value = newDate
frmCal.Show
End Sub

It is called as follows:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(ActiveCell, [I2,I4,L3,L36,L37]) Is Nothing Then
PopUpCalEntry ActiveCell
End If
End Sub

Anyone know how to avoid the unnecessary use of the ESC?
Originally adapted from

http://excel.bigresource.com/Track/excel-zi6Mrcjn/