Nifty Date Picker

Nifty Date Picker

There are some excellent date pickers available on the internet. So why should you chose the "Nifty Date Picker"?

First of all I've included details of my thought processes when I constructed it, including where I went wrong! This in itself will prove useful for anyone who wants to build stuff in MS Access.

It also gives you a very good handle on it, particularly if you want to modify this nifty date picker for your own particular use. I have also included a presentation, and a YouTube explaining how it works.

If that's not enough, then watch this space! This is just a beginning, I intend incorporating this "Nifty Date Picker" (Calendar Control) with my "Nifty Call Called" Class Module. The combination of the two will add some sophisticated functionality with benefit of ease of use.

With the class module added, you just need to call the Pop-Up calendar form "Nifty Date Picker" from any control and it will just work. It will take the caption from the Controls label and use that as the caption for the popup calendar form without you doing a thing! No coding!

Simulated After Update Event

By adding a simple piece of VBA code to your calling form, then the calendar form will be able to simulate the afterupdate event of the control it is associated with. This means if you have two dates, a person's date of birth, and today's date, then the code will automatically calculate the person's age without you having to press any other button. I haven't seen this functionality anywhere else.

Other benefits, the class module is a class! In essence it's a very simple class,  plus I've done a playlist on YouTube here which runs through the functionality of the class module and also how to associate it with your own pop-up form.

Object Oriented – Nifty Access

Nifty Date Picker - Free!

Nifty Date Picker - For "ALL" Versions of MS Access

Video 1 (18:39)

In this YouTube video  I demonstrate the Free "Nifty Date Picker" Suitable for "ALL" Versions of MS Access" I show you how to put together your own Nifty Date Picker Form. Why? Well a lot of code examples are only available in the later versions of MS Access (accdb). This means Some examples won't work in earlier versions of MS Access. I realised this could apply to my Nifty Date Picker it may not work in older versions of MS Access. You can download the VBA code BELOW and then construct the "Nifty Date Picker" by following the YouTube video instructions… "Hey Presto" You have a Free copy of the "Nifty Date Picker" that will work in ANY VERSION of MS Access.

Alternatively save yourself a lot of time and trouble and download the ready-made Access Date Picker – click on the link below:-
If you are like me, then you probably object to spending money on something you think you should have done yourself. Or maybe you feel guilty for paying for something you could have got for free. But look at it like this, I’ve done the work for you, it’s there waiting for you to use – no hassle – no trouble, and for what? The price of a cup of coffee! I’d love a coffee! press the button go on! Buy Me one!

Video 1 (18:39)

Nifty Access YouTube Thumb Nail
Play Video

Buy Tony a coffee!

Nifty Date Picker - User Case Examples

Select Date & Use It In a Query

Select Date & Use It In a Query

Video 1 (6:21)

This version of the “Nifty Date Picker” demonstrates how to use the date selected in code on the form it was called from. This is a custom situation, and custom code. I also have a solution which uses a Class Module which would make the Code generic and enable it to work with any form in any situation. See my website for more information about the clsCallCalled Class Module. For the purposes of the demonstration I have added dates to the Sample file:- 12th Aug 2019 and 19th Aug 2019. If you click on either the 12th or the 19th you will see the results for those dates returned in the Query.

Video 1 (6:21)

Nifty Access YouTube Thumb Nail
Play Video

Original OP Question on Access World Forums Here:-

… …

Option Compare Database
Option Explicit

'This is the latest version of the code, Updated Jan the 27th 2020
'Fixed a bug with highlighting the date, removed a bit of redundant code.

'I have removed all my custom error handling code from this free sample.

'######## -------------- Variables for the Property Statements ------- ########
Private mctrlInitialDate As Control
Private mTempDate As Date 'Temporary Date

'############## ---------------- Property Statements ----------------- ########
Property Set prpCtrlInitialDate(ctrlInitialDate As Control)
    Set mctrlInitialDate = ctrlInitialDate
End Property      'prpCtrlInitialDate Let

Property Get prpCtrlInitialDate() As Control
   Set prpCtrlInitialDate = mctrlInitialDate
End Property      'prpCtrlInitialDate Get

Property Let prpTempDate(ByVal datTempDate As Date)
    mTempDate = datTempDate
End Property      'prpTempDate Let

Property Get prpTempDate() As Date
    prpTempDate = mTempDate
End Property      'prpTempDate Get

'############## ------------------ Control Events -------------------- ########
Private Sub btnToday_Click()
    prpTempDate = Date
    Me.txtMth = prpTempDate
    Call fDisplayMth(prpTempDate)
    Call fSetAndClose(True)
End Sub      'btnToday_Click

Private Sub btnYrPlus1_Click()
    prpTempDate = DateAdd("yyyy", 1, prpTempDate)
    Me.txtMth = prpTempDate
    Call fDisplayMth(prpTempDate)
End Sub      'btnYrPlus1_Click

Private Sub btnYrMinus1_Click()
    prpTempDate = DateAdd("yyyy", -1, prpTempDate)
    Me.txtMth = prpTempDate
    Call fDisplayMth(prpTempDate)
End Sub      'btnYrMinus1_Click

Private Sub btnMthMinus1_Click()
    prpTempDate = DateAdd("m", -1, prpTempDate)
    Me.txtMth = prpTempDate
    Call fDisplayMth(prpTempDate)
End Sub      'btnMthMinus1_Click

Private Sub btnMthPlus1_Click()
    prpTempDate = DateAdd("m", 1, prpTempDate)
    Me.txtMth = prpTempDate
    Call fDisplayMth(prpTempDate)
End Sub      'btnMthPlus1_Click

Private Sub Form_Load()
    Me.Caption = Me.Name & " Ver B_1a "
End Sub      'Form_Load

Private Sub txtMth_AfterUpdate()
     prpTempDate = Me.txtMth
    Call fDisplayMth(prpTempDate)
End Sub      'txtMth_AfterUpdate

'############## ----------------- Primary Routines ------------------ ########
Public Function fSetUp()

        If Not IsDate(prpCtrlInitialDate) Then  'Handle No Date Supplied
            prpTempDate = Date
            prpCtrlInitialDate = Date
        Else
            prpTempDate = prpCtrlInitialDate    'Separate the Object Date from the Processed Date
        End If

        Me.txtMth = prpTempDate

        Call fDisplayMth(prpTempDate)

End Function      'fSetUp

Private Function fHighlightCurDate(ByVal dTempDate As Date, ByVal dInitialDate As Date)

Dim intInitialDay As Integer
intInitialDay = DatePart("d", dInitialDate)

    'If the Day matches the month and year, then highlight it
    If (DatePart("m", dTempDate) = DatePart("m", dInitialDate)) And (DatePart("yyyy", dTempDate) = DatePart("yyyy", dInitialDate)) Then
        Dim Ctrl As Control
           For Each Ctrl In Me.Controls
               Select Case Ctrl.ControlType
                   Case acCommandButton
                       If Ctrl.Caption = intInitialDay And Ctrl.Tag = "C" Then
                           Ctrl.FontSize = 11
                           Ctrl.ForeColor = RGB(255, 255, 255)
                           Ctrl.BackColor = RGB(30, 144, 255)
                       End If
               End Select
           Next Ctrl
    End If
End Function      'fHighlightCurDate

Private Function fDisplayMth(dInitialDate As Date)

Dim Ctrl As Control
Dim dFirstDayOfMth As Date

Dim intInitialDay As Integer
Dim intLastDayPrevMth As Integer

Dim intBtnTag As Integer            'Increment from 1 through to 42
Dim intPrevMth As Integer           'Increment the Previous Months Dates
Dim intInitialMth As Integer        'Increment the Alpha Months Dates (Current, Passed in Mth)
Dim intFollowMth As Integer         'Increment the Following Months Dates

dFirstDayOfMth = DateSerial(Year(dInitialDate), Month(dInitialDate), 1)

intLastDayPrevMth = DatePart("d", dFirstDayOfMth - 1)
intInitialDay = DatePart("d", dInitialDate)

intInitialMth = 1
intFollowMth = 1

intPrevMth = intLastDayPrevMth - Weekday(dFirstDayOfMth, vbMonday) + 2   'fWeekDayOffSet(dFirstDayOfMth) + 2

    For Each Ctrl In Me.Controls
        Select Case Ctrl.ControlType
            Case acCommandButton
            
                'Check to see if it is a Command Button in the 1 to 42 Grid (Its Prefix will be btnD)
                    If Left(Ctrl.Name, 4) = "btnD" Then
                    
                    'Setup Form
                        Ctrl.BackColor = RGB(147, 202, 221)
                        Ctrl.ForeColor = RGB(16, 37, 63)
     
                            '1 through 42 Counter
                                intBtnTag = intBtnTag + 1
     
                                    'Fill the Previous Month
                                        If Weekday(dFirstDayOfMth, vbMonday) > 0 And intPrevMth <= intLastDayPrevMth Then
                                            Ctrl.Tag = "P"
                                            Ctrl.BackColor = RGB(219, 238, 244)
                                            Ctrl.Caption = intPrevMth               'Set the Captions of the Command Buttons to the Previous month
                                            intPrevMth = intPrevMth + 1
                                        End If

                                    'Fill the Initial Month
                                        If intBtnTag >= Weekday(dFirstDayOfMth, vbMonday) Then
                                            Ctrl.Caption = intInitialMth              'Set the Captions of the Command Buttons to the Alpha month
                                            'intInitialMth
                                            Ctrl.Tag = "C"
                                                
                                                intInitialMth = intInitialMth + 1 'this is a poor name! it's a DAY not a month (Incremented = Incr)
                                        End If
                            
                        'Fill the Following Month
                            If intInitialMth > fLastDayOfMth(dFirstDayOfMth) + 1 Then
                                Ctrl.Tag = "F"
                                Ctrl.BackColor = RGB(219, 238, 244)
                                Ctrl.Caption = intFollowMth                     'Set the Captions of the Command Buttons to the Following month
                                intFollowMth = intFollowMth + 1
                            End If
                    End If
      End Select
    Next Ctrl
    
    Call fHighlightCurDate(prpTempDate, prpCtrlInitialDate)

End Function      'fDisplayMth

Private Function fGetCaption() As String

'The Calendar displays the  3 dates sections, previous month, current month and Following month.
'A value is placed in the Tag property of the command button to identify which date section the button belongs to

Dim intday As Integer
intday = Screen.ActiveControl.Caption
    
    Select Case Screen.ActiveControl.Tag
        Case Is = "P"   'Previous Month
            prpTempDate = fDateBuilder(prpTempDate, -1, intday)
        Case Is = "C"   'Current Month
            prpTempDate = fDateBuilder(prpTempDate, 0, intday)
        Case Is = "F"   'Following Month
            prpTempDate = fDateBuilder(prpTempDate, 1, intday)
    End Select

Call fSetAndClose(True)

End Function      'fGetCaption

Private Function fDateBuilder(dTempDate As Date, intOffSet As Integer, intday As Integer) As Date
'Used in Function fGetCaption()

    Dim intYear As Integer
    Dim intMth As Integer
    
            dTempDate = DateAdd("m", intOffSet, dTempDate)
            intYear = DatePart("yyyy", dTempDate)
            intMth = DatePart("m", dTempDate)
    
    fDateBuilder = intYear & "/" & intMth & "/" & intday
            
End Function      'fDateBuilder

Private Function fSetAndClose(blnSetDate As Boolean)
'This is the Exit Routine
    If blnSetDate Then
        prpCtrlInitialDate = prpTempDate 'Set the Object Date to the Processed Date
        DoCmd.Close acForm, Me.Name
    End If
End Function     'fSetAndClose

'############## ----------------- Helper Routines ------------------ ########
Private Function fLastDayOfMth(dDate As Date) As Byte

'                                 DateSerial( year, month, day )
    fLastDayOfMth = DatePart("d", DateSerial(Year(dDate), Month(dDate) + 1, 1) - 1)

End Function      'fLastDayOfMth

''''CALL IT Like THIS
'''Dim strFrmName As String
'''    strFrmName = "NiftyDatePicker"
'''        DoCmd.OpenForm strFrmName
'''            With Forms(strFrmName)
'''                Set .prpCtrlInitialDate = Me.txtEndDate
'''                .fSetUp
'''                '.Caption = "I CAN CHANGE THE CAPTION"
'''            End With

This website uses third-party software - WordPress Add-Ins to be exact. I don't know what any individual add-in does, but I'm sure that many of them collect information about you. So be aware, if you continue using this site, then you are likely to be sharing your information. I don't know how to disable this sharing for any, or all of the plugins for individual users. So I can't stop the sharing of information. If this worries you then please do not use this site... If you continue to use this site I will assume that you are happy with it.

Do you need a hand in the right direction?

You are in the right place.