Friday, January 1, 2010

Excel Macros : Excel Date Picker

This is first post of the year 2010, I wish all my blog readers a very happy and prospurous year. Today I am sharing Excel Date Picker Utility with you. Following picture will demonstrate some to the capabilities of this utility.

Photobucket



This utility will help you with following

1. In case you select a cell with date, or select any cell around the cell with a date. It will show floating button on the left side of the cell. If you click on the floating button it will show popup calender.
2. In case the cell already has a date , the calendar will show same date by default, else it will show current date.
3. You can jump the months by click on the month value on the popup calendar.
4. Click on the year will show spin buttons next to it and you can change year easily with spin buttons.
5. When you click on the date in popup calander, it will insert date clicked to the selected cell
6. You can also use Ctrl+Shift+d to show popup calender on your screen.
7. In case you get pop up calander and you do not want to click any date, just press Esc to close the pou up calendar.

This utility could be usefull in following ways

1. Many people end up entering date in text format as some time it is difficult to enter the date in correct computer readable format. With the popup calander, system takes care of the proper date entry.
2. Some times you have to get data from other users and you want them to enter dates in proper format so that rest of the worksheet can use those date inputs. With this utility you can be assured about this issue.

You may figure out many more usage based on your needs. The VBA code for Excel date Picker is available in the downloadable file. You can further modify the code as per your needs.

Now how to use this Excel Date Picker Utility



1. Download file and save it as Excel Addin on your machine.
2. You will need to copy this code to worksheet module of your workbook.

You will need to add this code to show the Floating button. This code will creat the button in case it does not exist on it. All other features like cell menu on right click and popup calender on Ctrl+Shift+d will be available in case you do not add this code by saving download able file as Excel Addin on your machine. I am suggesting this because I still need to learn how to trigger worksheet selection change event with a vba code in addin.


Private Sub FloatingButton_Click()
Calander.Show
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Application.CutCopyMode = 1 Then
Exit Sub
ElseIf Target.Cells.Count > 1 Then
Exit Sub
Else

Set r = Target
Hasdate = 0

For x = -1 To 1
For y = -1 To 1

On Error GoTo Etrap1

If IsDate(r.Offset(x, y)) Then
Hasdate = 1
Exit For
End If
Rsume1:
Next y
If Hasdate = 1 Then Exit For
Rsume:
Next x

If Hasdate = 1 Then

FloatingButton.Left = r.Offset(0, 1).Left
FloatingButton.Top = r.Top
FloatingButton.Visible = True

Else

If Not FloatingButton.Visible = False Then
FloatingButton.Visible = False
End If

End If

Exit Sub

End If

Etrap1:
If r.Row = 1 Then
Resume Rsume
ElseIf r.Column = 1 Then
Resume Rsume1
End If


End Sub

Private Sub Worksheet_Activate()
Dim s As String
On Error Resume Next
s = ActiveSheet.FloatingButton.Caption
If Err.Number <> 0 Then
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=147.75, Top:=34.5, Width:=15.75, Height:= _
15.75).Select

Selection.Name = "FloatingButton"
ActiveSheet.OLEObjects("FloatingButton").Object.Caption = ""
ActiveSheet.OLEObjects("FloatingButton").Object.BackColor = &H80000005
Range("A1").Select
FloatingButton.Visible = False
End If
On Error GoTo 0

End Sub


However this will not work on the files you send to other users. In that case you need to builtin the entire utility into the file you are sending out.

Following steps will help you to do this.

1. You will need to copy this code to workbook module of your workbook

Private Sub Workbook_Open()
Dim NewControl As CommandBarControl
Application.OnKey "+^{D}", "Module1.ShowCalander"
On Error Resume Next
Application.CommandBars("Cell").Controls("Show Date Picker").Delete
On Error GoTo 0
Set NewControl = Application.CommandBars("Cell").Controls.Add
With NewControl
.Caption = "Show Date Picker"
.OnAction = "Module1.ShowCalander"
.BeginGroup = True
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Cell").Controls("Show Date Picker").Delete
End Sub


2. You will need to copy this code to regular VBA module - Module1 of your workbook

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Private Const GWL_STYLE As Long = (-16)
Private wHandle As Long

Sub ShowCalander()
Calander.Show
End Sub


3. Move form named calander from the downloadable file to your file.

With these steps you can send the file to other users and it will work in similar way as it works on your machine.

In addition you can force users to enable macros while using your file

Download file with Excel Date Picker Utility

47 comments:

  1. Hello Rick

    Wish you a very happy and prosperous new year. I am sure that you will check comments on my post.

    I need some help from you. I need to learn class module prgramming. Can you suggest me some web pages or downloadable material for my learing.

    Regards//Yogesh Gupta

    ReplyDelete
  2. Hi Yogesh,

    Happy New Year to you too. Your posts are informative and sharing the codes helps budding code writers. As my Dad says "Knowledge is multiplied when Divided amongst others". Thanks for giving freely. I use some of your code.

    I need to apply the following code to a selected cell. I DO NOT know anything about coding in XL, but can work with Access VBA.

    ="Dhs. "&TEXT(A2,"#,##0.00")

    The above text if in A3 will convert A2 number (say 123456789) into Dhs. 1,234,567.89

    TIA.

    Ninad.

    ReplyDelete
  3. Hello Ninad

    In case you are entering formula manually you can enter it as below

    ="Dhs. "&TEXT(A2/100,"#,##0.00")

    In case you are entering it through VBA, use following code
    Range("A3").FormulaR1C1 = "=""Dhs. ""&TEXT(R[-1]C/100,""#,##0.00"")"

    I hope this should resolve your question.

    Let me know in case you have any further question.

    Regards

    ReplyDelete
  4. Hi Yogesh,

    How would I write code this as a Function ? Sorry but as I mentioned earlier Excel VBA is not my strength.

    My intention is to call a function with this formatting.

    Regards,

    Ninad.

    ReplyDelete
  5. Hello Ninad

    use following code for Function

    Function DHS(ByVal S) As String

    DHS = "Dhs. " & Format(S / 100, "#,##0.00")

    End Function

    Beware that the final value will be a string and can not be used for calculation further.

    Regards//Yogesh Gupta

    ReplyDelete
  6. Thanks. I am begining to learn this as Excel is more widely used at the current work place.

    Your code works, but the value of 123456789 gets truncated to Dhs. 12,345.68 WHY ?

    And Yes, the converted value will be a String.

    Ninad.

    ReplyDelete
  7. OK. I edited the S / 100 to S (as in your code) and it was fine.

    Curiosly, why did you use S / 100

    Ninad.

    ReplyDelete
  8. I am glad that you figured it out and made changes. Now your question by it did is in your first post.
    Quote
    "(say 123456789) into Dhs. 1,234,567.89"
    Unquote
    check out the format you have used for final output.
    Regards//Yogesh Gupta

    ReplyDelete
  9. Thanks Yogesh for the pointer. I figured it out.

    Regards,

    Ninad.

    ReplyDelete
  10. This Calender control works fine on my machine however it prompts an error "Could not load library..." on others machine with same Office version.
    Can you please let me know the reason behind this?

    ReplyDelete
  11. Hi Jonathan

    The calander control is windows functionality. I suggest that you check the windows version on others machine.

    Regards//Yogesh Gupta

    ReplyDelete
  12. Dear Sir

    Code for converting number into figures are for currency only, can we not convert in only numbers i.e. not in currency.

    ReplyDelete
  13. Thanks for this calendar picker code Yogesh. I added it to a workbook to be shared with others. Only issue is I don't see the button although it works fine by right clicking and selecting "Show date Picker".

    ReplyDelete
  14. Hi Yogesh,

    I am using Excel 2010 (64 bit) on Windows 7 (64 bit), and I am unable to get the date picker to work. Have you tried getting a date picker to work on 64 bit Excel 2010?

    Cheers,

    Paul

    ReplyDelete
  15. Dear Yogeshji,

    Excel Date Picker is not working in office 2007.

    Pls Confirm.

    Upendra Singh

    ReplyDelete
  16. Great article!
    In case anyone is coding-challenged and wants app solution, the following Excel date picker is now Free:
    http://www.wincalendar.com/excel-pop-up-calendar.html

    ReplyDelete
  17. I would like to limit the selectable dates to 01-01-2011 till 31-12-2011. How do I do that?
    Thanx

    ReplyDelete
  18. Yogesh ,
    how are u. i am having may excel files in a folder and each excle contains 3 woorksheets.

    can you please help me in a macro to print all the excle files ( that includes all 3 woork sheets )each in a folder and also another to make pdf and save in a folder

    ReplyDelete
  19. Help. When I used the popup calendar. The floating button is just white with no icon inside. newby here.

    ReplyDelete
  20. Hi Yogesh, I'm trying to convert your vba code in order to make it works on Office 64bit.
    But I got stuck at UserForm "Sub UserForm_Activate()"
    It said do not have method "MonthView1"
    I know vba7 has no more MonthView control.
    Maybe you have some clue ?

    ReplyDelete
  21. I too am having problems with MonthView1 being undefined with Office 2007. Can you please help?

    ReplyDelete
  22. Can you please describe step by step how to utilize the code for the datepicker. I'm trying to but can't figure it out. I'm not too computer savvy. Thanks! Also I have MS Office Excel 2010. Is this an issue?

    ReplyDelete
  23. Hi Yogesh

    Could you please tell how this calender utility activates when one select any particular cell??

    I mean if I select any cell in range it should pop up calender...

    Thanks

    ReplyDelete
  24. Hi there,
    For those who experience issues with the MonthView control, try the following:
    Open command prompt and type:
    regsvr32 mscomct2.ocx

    if the file is actually missing, check http://support.microsoft.com/kb/297381

    for 64bit systems, see also this thread
    http://social.msdn.microsoft.com/Forums/en/sbappdev/thread/91cf3127-70fe-4726-8a27-31b8964430c5

    Regards,
    Martin

    ReplyDelete
  25. it works for the most parts, but how come it dose not show floating button when mouse over the selected cell??

    ReplyDelete
  26. Hi Yogesh,

    This is the best date picker I have seen. Wondering if you could help? I have very limited VBA skills and want to use your date picker function for certain cells throughout a spreadsheet. How do I change thye code such that the date picker pop-up in say cell G4 & L15 as an example? I will be emailing the file to others.

    Many thanks, Nick.

    ReplyDelete
  27. when I have column were we have written a date like...01-Aug-2011, I need to separate find out the month by using farmula, in other column in text like...Aug..

    ReplyDelete
  28. Hi Yogesh,

    how to implement this date picker in a protected sheet? Where do I have to insert Sheet1.Unprotect "password" line?

    Its a great contrib anyway. Thanks!

    ReplyDelete
  29. Hi Yogesh,

    how can i activate the flowting calendar button on specific cells like you did in the "date picker" example excel sheet?

    thanks!

    ReplyDelete
  30. Hello Sir,
    How I can Maintain assets tag in excel workbook
    please suggest.

    ReplyDelete
  31. Yogesh,
    I'm a bit of a simpleton when it comes to these things but I tried to setup your date picker and am doing something wrong. It looks like from your description on how to use this all I have to do is place the downloaded file into the XLSTART folder where Excel saves recorded macros. I did that but now when I open one of my Excel files your file also gets opened and poking the Show Date Picker cell menu item yields a beep and locks until I poke ESC. I tried saving the file/macros as an XLA file but that didn't help (still two files and beeps). By the way - everything works fine in the date picker.xls sheet.

    Can you help?

    ReplyDelete
  32. Hello Yogesh,

    I am having difficulty adding this to my spreadsheet. If possible, could I email my workbook and you add your utility so that it works? I would appreciate any help!

    - Michael

    ReplyDelete
  33. sir, i m using drop down & vlookup function i creat a list of drop down. but when i use drop down it is working in sorting order. not in regular order.

    ReplyDelete
  34. Has anyone figured out how to get the small button to appear next to the cell when using the date picker? I can use it when right clicking and selecting date picker from the menu, but can't seem to get the small button to appear. I know I copied the code to a "T". Thanks.

    ReplyDelete
  35. I've had the same problem with the small floating button not popping up next to the cell and I believe I've solved the problem.

    After you finish copying the code using the steps mentioned above, you notice that there's a little square "command button" that pops up where it's not supposed to be. It's actually two command buttons overlapping each other. They do nothing. One of them is supposed to be your floating button. It doesn't matter which one, you just have to name it or position it right.

    1) Go into design mode (under the developer tab)
    2) Click on your command buttons and seperate your command buttons from each other
    3) Delete one and keep the other
    4) Take that one command button and put it next to a date cell like it's supposed to be if the code had worked correctly. Pick any date cell, it doesn't matter
    5) Click on its properties and change it's name to "FloatingButton" like it is written in the code. It might already be named like that though, no worries
    6) Exit design mode and viola! You now have a floating calendar button that works like it should

    You may notice that the button is plain with no calendar icon on it. Simple fix:
    1) Enable design mode again
    2) Click on your floating button and go to properties
    3) Click on picture and browse for a calender picture (a decent calendar icon I found on google was this: http://www.insead.edu/events/leadershipsummitasia2010/images/calendar_icon.jpg)
    4) Make sure the picture is centered by setting the picture position property to 12 (center)
    5) Exit design mode and there you have it

    Hope this works for everyone!

    ReplyDelete
  36. Hi,

    I need some quick advice. I used the SEP Date Control in Excel 2010 to create a date picker and would like to copy and paste the value of the date in a master spreadsheet. Is this possible?

    Thanks,

    T

    ReplyDelete
  37. Hello!

    I have try with your program and it works great, but I'm wondering if there is a way that a I can create a calendar on an UserForm and when I select a Date, this date will be written on a LisBox on an UserForm, do you kno how to do that??

    thanks!

    ReplyDelete
  38. Dear Mr Yogesh

    Here I again come with my problem.. :) I had downloaded your excel sheet provided over here. As I open the Sheet I get error
    "Could not load a object because it is not available on this machine"
    After that I click Ok and click on the small button I get beside date, there I again get same above error on clicking ok I am taking to Edit the script, where it shows "Compile Error: Can't find project or library" Then I lick OK again.It is showing error in this script:

    Private Sub UserForm_Initialize()
    Dim frm As Long, frmstyle As Long
    If Val(Application.Version) >= 9 Then
    wHandle = FindWindow("ThunderDFrame", Me.Caption)
    Else
    wHandle = FindWindow("ThunderXFrame", Me.Caption)
    End If
    If wHandle = 0 Then Exit Sub
    frm = GetWindowLong(wHandle, GWL_STYLE)
    frm = frm Or &HC00000
    SetWindowLong wHandle, -16, frmstyle
    DrawMenuBar wHandle

    With Me
    .Left = ActiveCell.Offset(0, 1).Left
    .Top = ActiveCell.Top + ActiveCell.Height + 15
    .StartUpPosition = 0
    End With

    End Sub

    whith "wHandle" highlighted in blue.... Help me plssssssssss!!!

    ReplyDelete
  39. Do you need any .ocx files for this to work?
    I get it working on some machines, others not.

    ReplyDelete
  40. Hi Yogesh - How can i get a pop up calendar in a Userform text box.?
    Let me know if you have a solution.
    Today is my second day on your blogsite - i would like to congratulate you for putting together such good material on VB. Hoping to learn a lot of things from you.
    Best regards
    Srikanth

    ReplyDelete
  41. Hi Yogesh,
    I have used Date Picker placed at E2 column and update Excel Column as Range("A2").Value=DatePicker.Value and called Sp from macro with Range("A2").Value as parameter.
    The problem is when i deselect designeer mode, one more datepicker is visible in extreame left of the excel and DatePicker at E2 become function less, also when i select Desginer Mode at Developer Tab, Extreame left DatePicker disappear.

    Please suggest, i just want to use and display DatePicker at E2 location only.

    ReplyDelete
  42. This is how i got it to work in office 2010. I simply added checks in the selectionchange routine of a page to look at the cells I had dates in.

    *****************************************************
    Option Explicit

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$B$21" Or Target.Address = "$B$23" Then _
    ShowCalander
    End Sub

    Private Sub startDateFloatingButton_Click()
    Range("B21").Select
    ShowCalander
    End Sub

    Private Sub endDateFloatingButton_Click()
    Range("B23").Select
    ShowCalander
    End Sub
    *****************************************************

    I then had to move the variables to the user form:

    *****************************************************
    Option Explicit

    Private Const GWL_STYLE As Long = (-16)

    Private wHandle As Long

    Private Sub CommandButton1_Click()
    Unload Me
    ActiveCell.Select
    End Sub

    Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
    ActiveCell = MonthView1.Value
    Unload Me
    ActiveCell.Select
    End Sub

    Private Sub UserForm_Activate()
    If Not IsDate(ActiveCell.Value) Then
    Me.MonthView1.Value = Date
    Else
    Me.MonthView1.Value = ActiveCell.Value
    End If
    End Sub

    Private Sub UserForm_Initialize()
    Dim frm As Long
    Dim frmstyle As Long

    If Val(Application.Version) >= 9 Then
    wHandle = FindWindow("ThunderDFrame", Me.Caption)
    Else
    wHandle = FindWindow("ThunderXFrame", Me.Caption)
    End If

    If wHandle = 0 Then Exit Sub

    frm = GetWindowLong(wHandle, GWL_STYLE)
    frm = frm Or &HC00000
    SetWindowLong wHandle, -16, frmstyle
    DrawMenuBar wHandle

    With Me
    .Left = ActiveCell.Offset(0, 1).Left
    .Top = ActiveCell.Top + ActiveCell.Height + 15
    .StartUpPosition = 0
    End With
    End Sub
    *****************************************************

    And Finally, here is the code in a module I called datePicker

    *****************************************************
    'Originally found at:
    'http://www.yogeshguptaonline.com/2010/01/excel-macros-excel-date-picker.html

    Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function ReleaseCapture Lib "user32" () As Long

    Sub ShowCalander()
    Calander.Show
    End Sub
    *****************************************************

    Hope this helps everyone. If there is more change needed, please post and I will see what I can do.

    ReplyDelete
  43. i have this error just when i open this file download from above link
    "
    ---------------------------
    Microsoft Visual Basic for Applications
    ---------------------------
    Compile error:

    Object library invalid or contains references to object definitions that could not be found
    ---------------------------
    OK Help
    ---------------------------

    ReplyDelete
  44. Can any one help me please i have already searched this a lot and tried all solutions but failed and failed.

    Help with solution will be appreciated strongly thanks

    jimi

    ReplyDelete
  45. Does anyone know how to format the value displayed on the Excel sheet after you set up the date picker? I don't like how it is left justified and the font is too small. Is there code I can program to alter the displayed value? Thanks

    ReplyDelete
  46. anyone know how to instead of typing 10-10-2010, i want to type 10.10.2010 for excel to detect it as date format

    ReplyDelete
  47. anyone know how to instead of typing 10-10-2010, i want to type 10.10.2010 for excel to detect it as date format

    ReplyDelete