Results 1 to 2 of 2
2014-05-20, 04:11 #1
- Join Date
- May 2014
- Johannesburg, South Africa
- Thanked 0 Times in 0 Posts
Need assistance with popup calendar macro in 2010
I am new to this site and Excel VBA.
I need to add a pop up calendar to specific columns in a spreadsheet and have managed to download a macro.
However, i need some changes made to the macro in order to make it work for my spreadsheet.
The changes are:
- Calendar should only work in columns B, C & R from row 3 all the way down.
- Calendar should pop up even when there is a date already in the active cell.
- Calendar must close when the date is selected by the user.
- the 'Ok' & 'Cancel' buttons must be removed.
- the calendar should close when ESC key is pressed.
- the calendar should pop up next to the active cell.
I know this is quite a bit of changes but i would really appreciate the assistance.
I have attached the macro.
Thank you in advance
2014-05-20, 21:38 #2
- Join Date
- Mar 2004
- Manning, South Carolina
- Thanked 1,456 Times in 1,325 Posts
Welcome to the Lounge as a new poster!
This should solve your first part about limiting the event to cols C,D,R from row 3 onward and it also solves the second part as it will pop up the picker even if a date is already present and set the picker date to that value.
Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim MyDate As Date Dim isect As Range Dim lLastRow As Long Dim zMyRng As String lLastRow = Rows().Count zMyRng = "B3:C" & Format(lLastRow) & ",R3:R" & Format(lLastRow) Set isect = Application.Intersect(Range(zMyRng), Target) If isect Is Nothing Then ' MsgBox "Ranges do not intersect" Else '***Prevent following code from refiring Change Event *** Application.EnableEvents = False MyDate = GetDate(Target.Value) If CLng(MyDate) = 0 Then MsgBox "You didn't select a date." & vbCr & _ "The action has been cancelled.", vbCritical, _ "Don't do anything" ' if the date was selected before insertion of the row ' the insert action could be cancelled at this point Else Target.Value = MyDate End If Application.EnableEvents = True '*** Reset Events *** End If End Sub 'Worksheet_SelectionChange()