Solved Filtering Dates (1 Viewer)

[craigachan]

I inherited a database where instead of a date field, the month, day, and year are in separate string fields in the table. If the dates that I want to filter span the end of one month to the beginning of the next month, how do I write this code: Example dates: 9/25/2022 to 10/1/2022. Basically I want the dates between 9/25/2022 AND 10/1/2022.

Thanks for any help.

 

[arnelgp]

you create first a query against the table, adding a Calculated column that will take the Day, Month, Year field and convert it into a date

(Query1)
select *, DateSerial(YearField, MonthField, DayField) As Dte from yourTableName where ((YearField+MonthField+DayField) Is Null) = False;

now, Create another query that will filter the above query:

(FinalQuery)
Select * From Query1 Where Dte >= #9/25/2022# And Dte <=#10/1/2022#

 

[craigachan]

Thank you so much. So here is what I have now.

dim dDate as date, startDate as date, endDate as date, msql as string, msqlA as string

startDate = dDate - Weekday(dDate) + 1
endDate = dDate - Weekday(dDate) + 7

msqlA = "SELECT *, DateSerial(ledger.[year], ledger.[month], ledger.[day]) AS DOS FROM ledger WHERE ((ledger.[year] + ledger.[month] + ledger.[day]) is Null) = False"

msql = "SELECT * FROM " & msqlA & " WHERE DOS >= #" & startDate & "# AND DOS <= #" & endDate & "#"

This ends up in a syntax error. I'm not sure what I'm doing wrong. Any idea what it is?

 

[Gasman]

Debug.Print your variables and see what they actually are.
Dates normally need to be formatted in mm/dd/yyyy or yyyy-mm-dd format in sql strings, not numbers?

Pretty much as @arnelgp showed you?

Edit: I used in some of my dbs a constant
Public Const strcJetDate = "\#mm\/dd\/yyyy\#" 'Needed for dates in queries as Access expects USA format.

then used that format in the sql string

strSQLDate = Format(pdtDateWE, strcJetDate)

 

[craigachan]

Sorry, to clarify my dDate is a date. So it is in the right format. I've attached a pic of the final sql.

 

[Gasman]

Seems @arnelgp suggested two queries?
If you are going to try and use a sub query I would expect that to be within brackets? ()

 

[craigachan]

Like this?

I get runtime 3065 cannot execute selected query

 

[moke123]

Copy and paste text is preferable over screenshots. No one wants to have to retype the whole query.

 

[Pat Hartman]

((YearField+MonthField+DayField) Is Null)

The & is the standard concatenation character. You can use the + in certain cases as long as you understand the difference between the two operands and how they handle null values and numeric values. However, if you use the + to "concatenate" numeric values, guess what happens.

 

[craigachan]

Sorry about that:

SELECT * FROM (SELECT *, DateSerial(ledger.[year], ledger.[month], ledger.[day]) AS DOS FROM ledger WHERE ((ledger.[year] + ledger.[month] + ledger.[day]) is Null) = False) WHERE DOS >= #9/25/2022# AND DOS <= #10/1/2022#

 

[arnelgp]

you can create the query in Query designer first and test it.
dont slumdunk.

 

[craigachan]

Thank you all so much. I finally realized what arnelgp was explaining. It all works now. Here is my code:

Dim startDate as date, endDate as date, dDate as Date, msql as string

startDate = dDate - Weekday(dDate) + 1
endDate = dDate - Weekday(dDate) + 7

If DoesTableExist("tempLedger") = True Then
DoCmd.DeleteObject acTable, "tempLedger"
End If

msql = "SELECT PatientID, AcctID, month, day, year, code, description, DateSerial(year, month, day) AS DOS INTO tempLedger FROM ledger"
CurrentDb.Execute msql

msql = "SELECT tempLedger.*, Trim(tempLedger.patientID) AS PID, trim(patient.lastname)&Chr(44) & Chr(32) & Trim(patient.firstname) AS PName, Right(Trim(templedger.description),6) AS SpecNum INTO tempWorkFlow " & _
"FROM tempLedger Left JOIN Patient ON templedger.patientID = Patient.ID " & _
"WHERE (DOS BETWEEN #" & startDate & "# AND #" & endDate & "#) AND Code = 'SP' ORDER BY DOS"
CurrentDb.Execute msql

 

[Gasman]

I would not have fields called Month, Day or Year, they are reserved words. If you have to have them surround them in []
I was thinking more along the lines of a query that created the date along with all the other data.

Then use that as your base for any other process that need the actual date.

 

[cheekybuddha]

Dim startDate as date, endDate as date, dDate as Date, msql as string

startDate = dDate - Weekday(dDate) + 1
endDate = dDate - Weekday(dDate) + 7

You never set dDate, so it uses a default value of 30/12/1899

How does the code you posted work?

Dim startDate as date, endDate as date, dDate as Date, msql as string

startDate = dDate - Weekday(dDate) + 1
endDate = dDate - Weekday(dDate) + 7
Debug.Print "dDate", Format(dDate, "yyyy-mm-dd hh:nn:ss")
Debug.Print "startDate", Format(startDate, "yyyy-mm-dd hh:nn:ss")
Debug.Print "endDate", Format(endDate, "yyyy-mm-dd hh:nn:ss")

' ...

Output in the Immedite Window (Ctrl+G):

dDate         1899-12-30 00:00:00
startDate     1899-12-24 00:00:00
endDate       1899-12-30 00:00:00

 

[cheekybuddha]

CurrentDb.Execute msql

This executes an action query (INSERT, UPDATE, DELETE etc ...) - it won't open a SELECT query.

Apologies, I missed the " INTO tempWorkFlow " in the second SQL

 

[Gasman]

This executes an action query (INSERT, UPDATE, DELETE etc ...) - it won't open a SELECT query.

Apologies, I missed the " INTO tempWorkFlow " in the second SQL

It is in the first sql as well?
I also missed it to start with.

 

[cheekybuddha]

Yes, it was the second invocation that i was questioning because at first I thought it was a plain SELECT statement.

 

[Pat Hartman]

In reality, the best solution is to make an actual date field. Also When you use dates as strings as they are used here:

DOS >= #9/25/2022# AND DOS <= #10/1/2022#

You have to be Very careful I don't know whether Access converts the DOS to a string or the string to a date. I wouldn't take the risk of using non-like data types when the wrong conversion will mess up the comparison. Strings are compared character by character, left to right so in fact the first string is > than the second string. Why? Because 9 is > 1. Dates are not stored internally as strings. They are stored as double precision numbers with the integer part being the number of days since Dec 30, 1899 and the decimal part is the portion of the day since midnight.

Rather than hard-coding dates, reference form fields. If the form fields are not bound to date fields, then set the format of the unbound control to short date so Access KNOWS the field is a date so there won't be any conversion necessary. It also means you don't have to keep modifying the query.

 

[craigachan]

Here is my code. Keep in mind that this is based on a sql db that doesn't alway cooperate with MSAccess Queries. The way I found around it was to create a tables of the queries that I want and then it converts field data correctly.
Thanks for everyones input.

Based on the main Forms!PatientDocsMain!nDate 1 Day:

Private Sub cmdWorkFlow_Click()
    Dim frmwf As Form
    DoCmd.Hourglass True
    DoCmd.OpenForm "PopupBuilding"
    Call LoadWorkFlowMain(Me.nDate, "d")
    DoCmd.OpenForm "WorkFlowMain", , , , acFormReadOnly
    Set frmwf = Forms!WorkFlowMain
    frmwf!lblTitle.Caption = "Work Flow For " & Me.nDate
    frmwf!nDate = Me.nDate
    frmwf!Mode = "d"
    DoCmd.Close acForm, "PopupBuilding"
    
cmdWFExit:
    DoCmd.Hourglass False
    Exit Sub
    
cmdWFErr:
    MsgBox "PatientDocsMain-cmdWorkFlowClick:" & Err.Number & " - " & Err.Description
    Resume cmdWFExit
End Sub

Based on Forms!PatientDocsMain!nDate 1 Week:

Private Sub cmdWorkFlowWk_Click()
    Dim frmwf As Form, startDate As Date, endDate As Date, msql As String, msqlA As String

    DoCmd.Hourglass True
    DoCmd.OpenForm "PopupBuilding"
    DoEvents
    Call LoadWorkFlowMain(Me.nDate, "w")
    DoCmd.OpenForm "WorkFlowMain", , , , acFormReadOnly
    Set frmwf = Forms!WorkFlowMain
    frmwf!lblTitle.Caption = "Work Flow For Week of " & Format(Me.nDate, "mm/dd/yyyy")
    frmwf!nDate = Me.nDate
    frmwf!Mode = "y"
    DoCmd.Hourglass False
    DoCmd.Close acForm, "PopupBuilding"
End Sub

Public Function LoadWorkFlowMain(dDate As Date, strPeriod As String)
    '====Loads form!WorkFlowMain
    On Error GoTo LoadWorkFlowMainErr
    
    Dim msql As String, msqlA As String, rs As DAO.Recordset, rsC As DAO.Recordset
    Dim strBMon As String, strBDay As String, strBYr As String
    Dim frmwf As Form, strPDFolder As String, strPID As String, strRecNum As String
    Dim startDate As Date, endDate As Date
    
    DoCmd.Hourglass True

    strBMon = Format(dDate, "mm")
    strBDay = Format(dDate, "dd")
    strBYr = Format(dDate, "yyyy")

    If DoesTableExist("tempWorkFlow") = True Then
        DoCmd.DeleteObject acTable, "tempWorkFlow"
    End If
    Select Case strPeriod
        Case "d"
            msql = "SELECT ledger.[Month] & Chr(47) & ledger.[Day] & Chr(47) & ledger.[Year] AS DOS, Trim(ledger.patientid) AS PID, " & _
                    "Trim(Patient.Lastname) & Chr(44) & Chr(32) & Trim(patient.firstname) AS PName, " & _
                    " Right(Trim(ledger.description),6) AS SpecNum, ledger.code, ledger.AcctID " & _
                    " INTO tempWorkFlow " & _
                    "FROM ledger LEFT JOIN Patient ON ledger.patientID = Patient.ID " & _
                    "WHERE (((ledger.[Year]) = '" & strBYr & "') AND ((ledger.[Month]) = '" & strBMon & "') AND ((ledger.[Day]) = '" & strBDay & "')) AND ((ledger.code) = 'SP')"
        Case "w"
            
            startDate = dDate - Weekday(dDate) + 1
            endDate = dDate - Weekday(dDate) + 7
            If DoesTableExist("tempLedger") = True Then
                DoCmd.DeleteObject acTable, "tempLedger"
            End If
            msql = "SELECT PatientID, AcctID, month, day, year, code, description, DateSerial(year, month, day) AS DOS INTO tempLedger FROM ledger"
            CurrentDb.Execute msql
            'DoCmd.OpenTable ("tempLedger")
            msql = "SELECT tempLedger.*, Trim(tempLedger.patientID) AS PID, trim(patient.lastname)&Chr(44) & Chr(32) & Trim(patient.firstname) AS PName, Right(Trim(templedger.description),6) AS SpecNum INTO tempWorkFlow " & _
                    "FROM tempLedger Left JOIN Patient ON templedger.patientID = Patient.ID " & _
                    "WHERE (DOS BETWEEN #" & startDate & "# AND  #" & endDate & "#) AND Code = 'SP' ORDER BY DOS"
            
        Case "m"
            msql = "SELECT ledger.[Month] & Chr(47) & ledger.[Day] & Chr(47) & ledger.[Year] AS DOS, Trim(ledger.patientid) AS PID, " & _
                    "Trim(Patient.Lastname) & Chr(44) & Chr(32) & Trim(patient.firstname) AS PName, " & _
                    " Right(Trim(ledger.description),6) AS SpecNum, ledger.code, ledger.AcctID " & _
                    " INTO tempWorkFlow " & _
                    "FROM ledger LEFT JOIN Patient ON ledger.patientID = Patient.ID " & _
                    "WHERE (((ledger.[Year]) = '" & strBYr & "') AND ((ledger.[Month]) = '" & strBMon & "') ) AND ((ledger.code) = 'SP') ORDER BY ledger.[Day]"
    End Select

    CurrentDb.Execute msql
    CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN WDAcctBal Text(20)"
    CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN AcctBal Text(20)"
    CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN Charged Text(20)"
    CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN PDocs Text(20)"
    CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN ID COUNTER"
    Set rs = CurrentDb.OpenRecordset("tempWorkFlow")
        Do Until rs.EOF
            strPID = rs!PID
            rs.Edit
                'Windent AcctBal
                    rs!WDAcctBal = DLookup("acctbal", "Account", "accountID = '" & rs!AcctID & "'")
                'PatientDocs AcctBal
                    Set rsC = CurrentDb.OpenRecordset("SELECT * FROM tblBillings WHERE AID = '" & rs!AcctID & "'")
                        If rsC.RecordCount = 0 Then
                            rs!AcctBal = "No Bill"
                        Else
                            Do Until rsC.EOF
                                If IsNull(rs!AcctBal) Then rs!AcctBal = CLng(0)
                                rs!AcctBal = CDbl(rs!AcctBal) + CDbl(rsC!BillBalance)
                                rsC.MoveNext
                            Loop
                        End If
                    rsC.Close
                'WD Charges
                    If DoesTableExist("tempWorkFlowCharges") = True Then
                        DoCmd.DeleteObject acTable, "tempWorkFlowCharges"
                    End If
                    CurrentDb.Execute ("SELECT ledger.code, ledger.patientid INTO tempWorkFlowCharges FROM ledger WHERE PatientID = '" & rs!PID & "' AND Code <> 'SP'")
                    Set rsC = CurrentDb.OpenRecordset("tempWorkFlowCharges")
                        rsC.MoveLast
                        strRecNum = rsC.RecordCount
                        rsC.MoveFirst
                        If strRecNum < 1 Then
                            rs!Charged = "XXX"
                        Else
                            Do Until rsC.EOF
                                If Trim(rsC!Code) = "REFFROM" Then
                                    rs!Charged = "XXX"
                                    GoTo skip
                                Else
                                    rs!Charged = "Posted"
                                    GoTo skip1
                                End If
skip:
                                rsC.MoveNext
                            Loop
skip1:
                        End If
                    rsC.Close
                'PatientDocs Files
                    strPDFolder = DLookup("PatientDocs", "LinkPaths") & strPID & "\"
                    If DoesFolderExist(strPDFolder) = True Then
                        rs!PDocs = "Good"
                    Else
                        rs!PDocs = "Missing"
                    End If
                    
            rs.Update
            '===Progress Bar
            Select Case Forms!PopupBuilding!lblBuilding.Caption
                Case "Building  Please Wait..."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... ."
                Case "Building  Please Wait... ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... . ."
                Case "Building  Please Wait... . ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... . . ."
                Case "Building  Please Wait... . . ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... . . . ."
                Case "Building  Please Wait... . . . ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... . . . . ."
                Case "Building  Please Wait... . . . . ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... . . . . . ."
                Case "Building  Please Wait... . . . . . ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... . . . . . . ."
                Case "Building  Please Wait... . . . . . . ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... . . . . . . . ."
                Case "Building  Please Wait... . . . . . . . ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... . . . . . . . . ."
                Case "Building  Please Wait... . . . . . . . . ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait... . . . . . . . . . ."
                Case "Building  Please Wait... . . . . . . . . . ."
                    Forms!PopupBuilding!lblBuilding.Caption = "Building  Please Wait..."
                    
            End Select
            DoEvents
            rs.MoveNext
        Loop
    rs.Close

LoadWorkFlowMainExit:
    DoCmd.Hourglass False
    Set frmwf = Nothing
    Set rs = Nothing
    Set rsC = Nothing
    msql = ""
    Exit Function
    
LoadWorkFlowMainErr:
    MsgBox "PatientDocsPulbic-LoadWorkFlowMain: " & Err.Number & " - " & Err.Description
    Resume LoadWorkFlowMainExit
    
End Function

Public Function DoesFolderExist(strFolderpathname As String)
        Dim strFolderExists As String
        strFolderExists = Dir(strFolderpathname)
        If strFolderExists = "" Then
            DoesFolderExist = False
        Else
            DoesFolderExist = True
        End If
End Function

 

[moke123]

You can shorten your function

Public Function DoesFolderExist(strFolderpathname As String) as boolean
 DoesFolderExist=Len(Dir(strFolderpathname, vbDirectory))
End Function