How to work with dates in Excel VBA SQL. Trying to create a select statement where [orientation date] is greater than a chosen date variable

Question

The SQL select statement that I created in Excel VBA is not working properly with dates. I have tried putting the date as a variable and just entering not as a variable, also with # signs and not. The statement works in that it provides results, but the dates from the [Orientation Date] column are not filtered how I want. For instance, I set strCurrentDate365 to equal to 23 Oct 2023. Then in the SQL statement I want it to return records where the [Orientation Date] is greater than strCurrentDate365, but the results includes records with all dates, lesser and greater.

Sub employeeInquiry()

Dim strCurrentDate365 As Date
strCurrentDate365 = "23 Oct 2023"
strCurrentDate365 = Format(strCurrentDate365, "mm/dd/yyyy")

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

'********************* Annual Expirations *******************
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon

strSQL = "SELECT [Employee ID#], [Employee Name], [Company], cdate([Orientation Date]) " & _
         "FROM [Training_Database$] " & _
         "WHERE [Employee Name] IS NOT NULL " & _
         "AND [Employee Name] <> 'blank space' " & _
         "AND [Employee Name] <> 'Employee Name' " & _
         "AND [Orientation Date] > #" & strCurrentDate365 & "# "

rs.Open strSQL, cn

'select and clear results sheet
Sheets("Inquiry_Results").Select
Cells.ClearContents

'row and column to insert
Dim r As Integer
r = 2
Dim c As Integer
c = 1

'insert result
Cells(r, c).CopyFromRecordset rs

rs.Close
cn.Close

End Sub

Test Table:

Employee ID#	Employee Name	Company	Orientation Date
blank space	blank space	blank space	Lifetime
blank space	blank space	blank space	WFD
blank space	blank space	blank space	5 hours
Employee ID#	Employee Name	Company	Orientation Date
752856	Smith, John	Waste LLC	12/28/2023
685273	Jones, Tracy	Paint & Co	11/7/2023
385418	Ramirez, Jen	Waste LLC	12/23/2023
787233	Johnson, Ted	Paint & Co	10/7/2023
988534	Smith, Jane	Waste LLC	10/22/2023
438541	Williams, Ken	PipeFab LLC	11/18/2023

Things to try - Parameterised query and non-ambiguous (or less ambiguous) date format e.g. yyyy-MM-dd — CHill60
– CHill60, Commented Dec 19, 2023 at 15:57

Storax · Accepted Answer · 2023-12-19 18:36:28Z

1

This part of the code will run into an error if you have "wrong" regional settings like I do

Dim strCurrentDate365 As Date
strCurrentDate365 = "23 Oct 2023"
strCurrentDate365 = Format(strCurrentDate365, "mm/dd/yyyy")

I'd suggest to write it like that (I also removed the use of hungarian notation)

Dim currentDate365 As Date
currentDate365 = #10/23/2023#

It is also wrong to use CDATE in the SQL string as you did unless you indeed have a column with the title cdate([Orientation Date] what I think you do not have. You cannot convert a column to date in such a way.

The "trick" in this case is to use CDbl as MS Office programmes (Excel & Access, for example) use doubles to store dates and times: "AND [Orientation Date] > CDbl(currentDate365)"

Sub employeeInquiry()

    Dim currentDate365 As Date
    ' Use a date, do not rely on implicit conversion
    currentDate365 = #10/23/2023#
    
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    Dim strFile As String
    Dim strCon As String
    
    strFile = ThisWorkbook.FullName
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
        & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    '********************* Annual Expirations *******************
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    cn.Open strCon

    Dim strSQL As String
    ' Using cdate in the string does not make any sense
    strSQL = "SELECT [Employee ID#], [Employee Name], [Company], [Orientation Date] " & _
        "FROM [Training_Database$] " & _
        "WHERE [Employee Name] IS NOT NULL " & _
        "AND [Employee Name] <> 'blank space' " & _
        "AND [Employee Name] <> 'Employee Name' " & _
        "AND [Orientation Date] > " & CDbl(currentDate365)
        
    rs.Open strSQL, cn
    
    Sheets("Inquiry_Results").Cells.ClearContents

    'row and column to insert
    Dim r As Integer
    r = 2
    Dim c As Integer
    c = 1

    'insert result
    Sheets("Inquiry_Results").Cells(r, c).CopyFromRecordset rs

    rs.Close
    cn.Close

End Sub

Update: One can avoid the trick with CDbl by using parameters

Sub employeeInquiry()

    Dim currentDate365 As Date
    ' Use a date, do not rely on implicit conversion
    currentDate365 = #10/23/2021#
    
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    Dim strFile As String
    Dim strCon As String
    
    strFile = ThisWorkbook.FullName
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
        & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    '********************* Annual Expirations *******************
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    cn.Open strCon

    Dim Cm As ADODB.Command
    Dim Pm As ADODB.Parameter
    
    Dim strSQL As String

    strSQL = "SELECT [Employee ID#], [Employee Name], [Company], [Orientation Date] " & _
        "FROM [Training_Database$] " & _
        "WHERE [Employee Name] IS NOT NULL " & _
        "AND [Employee Name] <> 'blank space' " & _
        "AND [Employee Name] <> 'Employee Name' " & _
        "AND [Orientation Date] > ?;"
   
    Set Cm = New ADODB.Command
    With Cm
        .ActiveConnection = cn
        .CommandText = strSQL
        .CommandType = adCmdText

        Set Pm = .CreateParameter("orientDate", adDate, adParamInput)
        Pm.Value = currentDate365
        .Parameters.Append Pm
        
        Set rs = .Execute
        
    End With
    

    Sheets("Inquiry_Results").Cells.ClearContents

    'row and column to insert
    Dim r As Integer
    r = 2
    Dim c As Integer
    c = 1

    'insert result
    Sheets("Inquiry_Results").Cells(r, c).CopyFromRecordset rs

    rs.Close
    cn.Close

End Sub

edited Dec 19, 2023 at 18:36

answered Dec 19, 2023 at 17:18

Storax

12.7k3 gold badges21 silver badges36 bronze badges

Sign up to request clarification or add additional context in comments.

13 Comments

ryanm Over a year ago

Would you be able to provide some additional assistance. I copy pasted exactly what you have here, and it gives: (Run-time error '-2147217904(80040e10)': No value given for one or more required parameters.) So I changed the final line of the select statement to: "AND [Orientation Date] > " & CDbl(currentDate365) & "" so that it could recognize the variable. Then it gives another error of: Data type mismatch in criteria expression.

Storax Over a year ago

Sorry, I mand an error when copying the code. I fixed that and I updated it with another version how to do that which was mentioned in one of the comments.

ryanm Over a year ago

So, the update, it ran but still returned records with a date less than 10/23/2023.

ryanm Over a year ago

I would actually prefer to go the route of your first response if possible. There is still an error in it somewhere, the last line you have as { "AND [Orientation Date] " & > CDbl(currentDate365) } which is not working also.

Storax Over a year ago

You have to make sure that you have dates in the column [Orientation Date].

|

MT1 · Accepted Answer · 2024-01-15 09:06:28Z

The way Excel sees cell contents and the way SQL, used from VBA to query Excel sheets, sees cell contents are not the same.

I took the data from the OPs question and pasted it into Excel as is and the result was the first four columns of the screenshot below.

In column four, "Orientation Date" only two of the pasted data values are recognised as dates on my UK format computer.

In column five, "Manually Typed UK Date" I have typed in the values from the previous column in valid UK date format.

In column six, "Copy Paste Values" I copied the previous column and pasted the values into the next column.

In column seven, I manually applied a Format to the column using (select the six cells), (right click), Format Cells > Number > Date > default type - this is UK format again. The cells contained a formula referencing the cell in column six. The warning is "The number format applied to this cell may be misleading"

In column eight I used the subroutine sbFixDates as follows -

Sub sbFixDates()
    Dim c As Range
    For Each c In Range("H6:H11")
        c.Value = CDate(c.Value)
    Next
    Range("H6:H11").NumberFormatLocal = "m/d/yyyy hh:mm:ss"
End Sub

which was adapted slightly from this post This forces a change to a date datatype and then applies a US format to the result. This on my computer set up for UK format dates.

In the next five columns I used this below helper function

Public Function fnVarTypeDesc(c As Range) As String
' https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/vartype-function
' Constant           Value   Description
' vbEmpty            0       Empty (uninitialized)
' vbNull             1       Null (no valid data)
' vbInteger          2       Integer
' vbLong             3       Long integer
' vbSingle           4       Single-precision floating-point number
' vbDouble           5       Double-precision floating-point number
' vbCurrency         6       Currency value
' vbDate             7       Date value
' vbString           8       String
' vbObject           9       Object
' vbError            10      Error value
' vbBoolean          11      Boolean value
' vbVariant          12      Variant (used only with arrays of variants)
' vbDataObject       13      A data access object
' vbDecimal          14      Decimal value
' vbByte             17      Byte value
' vbLongLong         20      LongLong integer (valid on 64-bit platforms only)
' vbUserDefinedType  36      Variants that contain user-defined types
' vbArray            8192    Array (always added to another constant when returned by this function)

' vbEmpty            0       Empty (uninitialized)
 If VarType(c) = 0 Then fnVarTypeDesc = "Empty (uninitialized)"
' vbNull             1       Null (no valid data)
 If VarType(c) = 1 Then fnVarTypeDesc = "Null (no valid data)"
' vbInteger          2       Integer
 If VarType(c) = 2 Then fnVarTypeDesc = "Integer"
' vbLong             3       Long integer
 If VarType(c) = 3 Then fnVarTypeDesc = "Long integer"
' vbSingle           4       Single-precision floating-point number
 If VarType(c) = 4 Then fnVarTypeDesc = "Single-precision floating-point number"
' vbDouble           5       Double-precision floating-point number
 If VarType(c) = 5 Then fnVarTypeDesc = "Double-precision floating-point number"
' vbCurrency         6       Currency value
 If VarType(c) = 6 Then fnVarTypeDesc = "Currency value"
' vbDate             7       Date value
 If VarType(c) = 7 Then fnVarTypeDesc = "Date value"
' vbString           8       String
 If VarType(c) = 8 Then fnVarTypeDesc = "String"
' vbObject           9       Object
 If VarType(c) = 9 Then fnVarTypeDesc = "Object"
' vbError            10      Error value
 If VarType(c) = 10 Then fnVarTypeDesc = "Error value"
' vbBoolean          11      Boolean value
 If VarType(c) = 11 Then fnVarTypeDesc = "Boolean value"
' vbVariant          12      Variant (used only with arrays of variants)
 If VarType(c) = 12 Then fnVarTypeDesc = "Variant (used only with arrays of variants)"
' vbDataObject       13      A data access object
 If VarType(c) = 13 Then fnVarTypeDesc = "A data access object"
' vbDecimal          14      Decimal value
 If VarType(c) = 14 Then fnVarTypeDesc = "Decimal value"
' vbByte             17      Byte value
 If VarType(c) = 17 Then fnVarTypeDesc = "Byte value"
' vbLongLong         20      LongLong integer (valid on 64-bit platforms only)
 If VarType(c) = 20 Then fnVarTypeDesc = "LongLong integer (valid on 64-bit platforms only)"
' vbUserDefinedType  36      Variants that contain user-defined types
 If VarType(c) = 36 Then fnVarTypeDesc = "Variants that contain user-defined types"
' vbArray            8192    Array (always added to another constant when returned by this function)
' therefore VarType cannot return vbArray 8192 type
End Function

This function evaluated the datatype of the previous five columns. SQL when used from VBA uses this datatype. This adds a detailed explanation to the first answer

Collectives™ on Stack Overflow

How to work with dates in Excel VBA SQL. Trying to create a select statement where [orientation date] is greater than a chosen date variable

2 Answers 2

13 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

13 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related