Creating a Date Prompt Form

We’re going to replace XL’s limited InputBox function with a user form.  If you’ve never created a user form, don’t worry.  YouTube has several decent tutorials for you.  Check these out (at least the first one anyway), then come back here.

YouTube videos on how to create forms in VBA
Creating a User Form in Excel Part 1 of 3
Creating a User Form in Excel Part 2 of 3
Creating a User Form in Excel Part 3 of 3

Great, you’re back.  Now what follows may look intimidating.  But trust me, the juice is worth the squeeze since properly setup forms can be exported from the original project and imported directly into others without change.  So now that you know the basics of creating a user form, create one that looks like this with the element names and properties shown below:

frmPrompt - Dates

Next, paste the following code into the form’s code window.  Note that each form element has its properties coded/exposed.  This allows calling routines to set parameter defaults and retrieve parameter values after OK is pressed. 

'   Version 11/01/09

Option Explicit

'   Name: frmPrompt

'   Purpose: Ask the user for what they want to load

'     Date   Init Modification
'   01/12/06 CWH  Initial Programming

'   Example - see Public Sub TestForm():

'Public Sub TestForm()
'
'   With frmPrompt
'      .pDateLbl = "Dates"
'      .pFrom = Format(DateAdd("d", -Day(Now()) + 1, _
'                      DateAdd("m", -1, Now())), _
'                      "mm/dd/yyyy")                 'Start of last Month
'      .pTo = Format(DateAdd("d", -Day(Now()), _
'                    Now()), _
'                    "mm/dd/yyyy")                   'End of Last Month
'      .Show                                         'Display the Prompt
'       Do While .Visible                            'Wait on user
'           DoEvents
'       Loop
'       If .pOK Then                                 'OK button used to exit
'           Debug.Print .pFrom, .pTo
'       End If
'   End With
'
'End Sub

    Dim bOK As Boolean

'   Properties

'   Dates
Public Property Let pDateLbl(sString As String)
    lblDate.Caption = sString
End Property

'   From Date
Public Property Let pFrom(sString As String)
    txtFrom.Text = sString
End Property
Public Property Get pFrom() As String
    pFrom = txtFrom.Text
End Property

'   To Date
Public Property Let pTo(sString As String)
    txtTo.Text = sString
End Property
Public Property Get pTo() As String
    pTo = txtTo.Text
End Property

'   OK button
Public Property Get pOK() As Boolean
    pOK = bOK
End Property

'   Event Handlers

'   Exit Button
Private Sub cmdExit_Click()
    Me.Hide
End Sub

'   OK Button
Private Sub cmdOK_Click()

    Dim s As String             'Generic String
    Dim bError As Boolean
        bError = False
       
    If txtFrom > "" And Not IsDate(txtFrom) Then
        lblMsg.ForeColor = RGB(127, 0, 0)
        Beep
        lblMsg = "Please Check 'From' date"
        bError = True
    ElseIf txtTo > "" And Not IsDate(txtTo) Then
        lblMsg.ForeColor = RGB(127, 0, 0)
        Beep
        lblMsg = "Please Check 'To' date"
        bError = True
    ElseIf IsDate(txtFrom) And IsDate(txtTo) Then
        If DateValue(txtFrom) > DateValue(txtTo) Then
            s = txtFrom
            txtFrom = txtTo
            txtTo = s
            lblMsg.ForeColor = RGB(127, 64, 0)
            Beep
            lblMsg = "From & To dates swapped. Click OK to continue."
            bError = True
        End If
    End If
   
    If Not bError Then
        lblMsg.ForeColor = RGB(0, 127, 0)
        lblMsg = "Working - This can take a minute or two."
        bOK = True
        lblMsg = ""
        Me.Hide
    End If
       
End Sub

'   Activate Form
Private Sub UserForm_Activate()
    Me.Left = Application.Left + Application.Width / 2 - Me.Width / 2
    bOK = False
    lblMsg = ""   
End Sub

Lastly, modify our Macro1() to look like the code below.  Note the “With frmPrompt” along with the property settings that follow.  The SQL has also been modified to select based on dates (Access format).

Sub Macro1()

    Dim sSQL As String
    Dim sConnect As String
  
    With frmPrompt
        .pDateLbl = "Order Dates"                    'Label date prompt
        .pFrom = "01/01/2001"                        'Default to Jan.01 2001
        .pTo = Format(Now()), "mm/dd/yyyy")          'Default to today
        .Show                                        'Display the Prompt
        Do While .Visible                            'Wait on user 
            DoEvents
        Loop
        If .pOK Then                                 'OK button used to exit
            sConnect = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};" & _
                       "DBQ=C:\Users\chatmaker\Documents\Northwind 2007.accdb;" 
            sSQL = "SELECT O.`Order ID`, O.`Customer ID`, " & vbCr & _
                   "       O.`Order Date`, C.`First Name`, " & vbCr & _
                   "       O.`Ship State/Province`, D.Quantity, " & vbCr & _
                   "       P.`Product Name` " & vbCr & _
                   "FROM   Customers C, Orders O, " & vbCr & _
                   "       `Order Details` D, Products P " & vbCr & _
                   "WHERE  O.`Customer ID` = C.ID " & vbCr & _
                   "  AND  O.`Order ID`    = D.`Order ID` " & vbCr & _
                   "  AND  D.`Product ID`  = P.ID " & vbCr & _
                   "  AND  O.`Order Date` " & _
                           "Between #" & Format(.pFrom, "mm/dd/yyyy") & _
                           "#  And  #" & Format(.pTo, "mm/dd/yyyy") & "# "
            SQLLoad sSQL, sConnect, "A4", "Data", "Data"
            Pivot_Template
        End If
    End With

End Sub

How to Copy Code from this Blog to XL

1. Open your XL spreadsheet containing modGeneral.
2. Get to the VBE (Alt-F11)
3. Open modGeneral in the Code Window
4. From this post, select and copy the code
5. Paste into the Code Window (*see next paragraph)
6. Make any corrections to code that didn’t paste correctly
7. From the VBE menu navigate File > Export File…
8. Save modGeneral and remember where you saved it.

Unfortunately, the code won’t paste 100% properly.  You will have to add carriage returns and perhaps fix a few things until your code looks exactly like what you see here.