Overlapping dates with some null data (1 Viewer)

[bilakos93]

hello people!!

I have a tblCovid where essentially I keep hospital admissions (StudID, StartDate, EndDate). EndDate can be null if the Stud is already admitted
what I'm trying to do is create a vba code which will prevent users from entering overlapping admissions.
This how far I've come so far but still not quite there
Note that if there is an existing admission with no enddate , then the user can create another record only if the enddate of the new record is before the start date of the existing admission.

Public Function CheckAdmissionOverlap(StartDate As Date, EndDate As Variant, StudID As Long, TableName As String, ByVal FormName As String, ByVal IDFieldName As String) As Boolean
    ' Function to check if there is an overlap with existing admission records
    Dim strSQL As String
    Dim overlapCount As Long

    ' Format dates for use in the SQL query (dd/mm/yyyy format)
    Dim frmStartDate As String
    Dim frmEndDate As String
    frmStartDate = "#" & Format(StartDate, "dd/mm/yyyy") & "#"
    frmEndDate = "#" & Format(EndDate, "dd/mm/yyyy") & "#"

    ' Build the SQL string to count overlapping entries
    strSQL = "StudID = " & StudID

    ' Change to recordset (arnelgp)
    Dim db As DAO.Database, SameStudID As Boolean
    Set db = CurrentDb

    If Len(FormName) > 0 And Len(IDFieldName) > 0 Then
        Dim RecordID As Long
        RecordID = Forms(FormName).Controls(IDFieldName).Value

        With db.OpenRecordset("SELECT ID, StartDate AS tblStartDate, EndDate AS tblEndDate FROM " & TableName & " WHERE " & strSQL, dbOpenSnapshot, dbReadOnly)
            SameStudID = (.RecordCount <> 0)
            If SameStudID Then
                .MoveFirst

                Do Until .EOF
                    If ![ID] <> RecordID Then
                        If frmEndDate = "" Or IsNull(![tblenddate]) Then
                            ' Handle the case where either frmEndDate is an empty string or tblEndDate is null
                            If frmEndDate = "" And IsNull(![tblenddate]) Then
                                overlapCount = overlapCount + 1
                                MsgBox "There is an overlap, please check again", vbExclamation, "OverlapCheck"
                            ElseIf Not IsNull(![tblenddate]) Then
                                If ![tblenddate] >= StartDate Then
                                    overlapCount = overlapCount + 1
                                    MsgBox "This student is already admitted on " & Format(StartDate, "dd-mm-yyyy") & ".", vbExclamation, "OverlapCheck"
                                End If
                            ElseIf Not frmEndDate = "" Then
                                If frmEndDate >= ![tblstartdate] Then
                                    overlapCount = overlapCount + 1
                                    MsgBox "This student is already admitted on " & frmEndDate & ".", vbExclamation, "overlapcheck"
                                End If
                            End If
                        Else
                            ' No empty string or null values, use the strSQL condition
                            strSQL = "StudID = " & StudID & " " & _
                                     "AND ((StartDate <= " & frmEndDate & " AND EndDate >= " & frmStartDate & ") " & _
                                     "OR (StartDate <= " & frmStartDate & " AND EndDate >= " & frmEndDate & "))"

                            ' For demonstration purposes, printing the final strSQL
                            Debug.Print "Final SQL Query: " & strSQL
                            Debug.Print "OverlapCount: " & overlapCount
                        End If
                    End If
                    .MoveNext
                Loop
            End If
        End With
    End If

    ' Return True if there is an overlap, False otherwise
    CheckAdmissionOverlap = (overlapCount > 0)
End Function

 

[jdraw]

See this by PBaldy to ensure your logic is consistent.

 

[bilakos93]

thank you
I've got the point but i'm struggling to handle my null data.

 

[jdraw]

Please tell us more about the Null value issue. We need some specifics to understand the issue.
Can you post a description with example? Even a copy of the database?

 

[bilakos93]

it's tblCovid and frmCovid
It's entirely like admissions in a hospital
A studID can have an entry with startdate 1st Feb and no enddate. When someone tries to enter a new admission with startdate 15th Jan and enddate 20th Jan should be allowed to. They shouldn't be allowed though to enter an admission with startdate 15th Jan and enddate 15th Feb.
On the other hand , if there is an entry with startdate 1st Feb and enddate 15th Feb, the system shouldn't allow users to enter another entry with startdate 10thFeb and enddate 20th Feb. Although they should be allowed to enter startdate 20th Feb and no enddate.

In my mind
Let's name tblStartDate and tblEndDate the dates of the existing entry and frmStartDate and frmEndDate the dates that the user is trying to put in

If isnull(tblEndDate) or isnull(frmStartDate) Then
    If isnull(tblEndDate) and isnull(frmStartDate) Then
    overlapcount=overlapcount+1
    'there is an overlap
    End If
ElseIf isnull(tblEndDate) and not isnull(frmStartDate) then
        If frmEndDate>=tblStartDate then
        overlapcount=overlapcount+1
        ' there is an overlap when tblEndDate is null and frmStartDate is not null and FrmEndDate>=tblStartDate
        End If   
Else
    If tblEndDate>=frmStartDate then
    overlapcount=overlapcount+1
    'same principle
    End If
End If

Otherwise (when there is no null data) it's the thing you metioned before

 

[LarryE]

hello people!!

I have a tblCovid where essentially I keep hospital admissions (StudID, StartDate, EndDate). EndDate can be null if the Stud is already admitted
what I'm trying to do is create a vba code which will prevent users from entering overlapping admissions.
This how far I've come so far but still not quite there
Note that if there is an existing admission with no enddate , then the user can create another record only if the enddate of the new record is before the start date of the existing admission.

Public Function CheckAdmissionOverlap(StartDate As Date, EndDate As Variant, StudID As Long, TableName As String, ByVal FormName As String, ByVal IDFieldName As String) As Boolean
    ' Function to check if there is an overlap with existing admission records
    Dim strSQL As String
    Dim overlapCount As Long

    ' Format dates for use in the SQL query (dd/mm/yyyy format)
    Dim frmStartDate As String
    Dim frmEndDate As String
    frmStartDate = "#" & Format(StartDate, "dd/mm/yyyy") & "#"
    frmEndDate = "#" & Format(EndDate, "dd/mm/yyyy") & "#"

    ' Build the SQL string to count overlapping entries
    strSQL = "StudID = " & StudID

    ' Change to recordset (arnelgp)
    Dim db As DAO.Database, SameStudID As Boolean
    Set db = CurrentDb

    If Len(FormName) > 0 And Len(IDFieldName) > 0 Then
        Dim RecordID As Long
        RecordID = Forms(FormName).Controls(IDFieldName).Value

        With db.OpenRecordset("SELECT ID, StartDate AS tblStartDate, EndDate AS tblEndDate FROM " & TableName & " WHERE " & strSQL, dbOpenSnapshot, dbReadOnly)
            SameStudID = (.RecordCount <> 0)
            If SameStudID Then
                .MoveFirst

                Do Until .EOF
                    If ![ID] <> RecordID Then
                        If frmEndDate = "" Or IsNull(![tblenddate]) Then
                            ' Handle the case where either frmEndDate is an empty string or tblEndDate is null
                            If frmEndDate = "" And IsNull(![tblenddate]) Then
                                overlapCount = overlapCount + 1
                                MsgBox "There is an overlap, please check again", vbExclamation, "OverlapCheck"
                            ElseIf Not IsNull(![tblenddate]) Then
                                If ![tblenddate] >= StartDate Then
                                    overlapCount = overlapCount + 1
                                    MsgBox "This student is already admitted on " & Format(StartDate, "dd-mm-yyyy") & ".", vbExclamation, "OverlapCheck"
                                End If
                            ElseIf Not frmEndDate = "" Then
                                If frmEndDate >= ![tblstartdate] Then
                                    overlapCount = overlapCount + 1
                                    MsgBox "This student is already admitted on " & frmEndDate & ".", vbExclamation, "overlapcheck"
                                End If
                            End If
                        Else
                            ' No empty string or null values, use the strSQL condition
                            strSQL = "StudID = " & StudID & " " & _
                                     "AND ((StartDate <= " & frmEndDate & " AND EndDate >= " & frmStartDate & ") " & _
                                     "OR (StartDate <= " & frmStartDate & " AND EndDate >= " & frmEndDate & "))"

                            ' For demonstration purposes, printing the final strSQL
                            Debug.Print "Final SQL Query: " & strSQL
                            Debug.Print "OverlapCount: " & overlapCount
                        End If
                    End If
                    .MoveNext
                Loop
            End If
        End With
    End If

    ' Return True if there is an overlap, False otherwise
    CheckAdmissionOverlap = (overlapCount > 0)
End Function

Try:
Dim frmStartDate As Date
Dim frmEndDate As Date

But the most effective way to find duplicate admissions is to use a Find Duplicates query like:

SELECT First(tblHosp.[StudID]) AS [StudID Field], First(tblHosp.[AdmDate]) AS [AdmDate Field], Count(tblHosp.[StudID]) AS NumberOfDups
FROM tblHosp
GROUP BY tblHosp.[StudID], tblHosp.[AdmDate]
HAVING (((Count(tblHosp.[StudID]))>1) AND ((Count(tblHosp.[AdmDate]))>1));

Then you can count the number of duplicates for any student and take action from there.

By the way, I noticed many Primary Key ID numbers named simply "ID". Never allow Primary Key ID's to remain named "ID". Rename them. For example,
The Primary Key ID in the table tblStudents should be StudentID, not just ID. You will have nothing but problems with this database if you have identical Primary Key names in different tables.

 

[Isaac]

By the way, I noticed many Primary Key ID numbers named simply "ID". Never allow Primary Key ID's to remain named "ID". Rename them. For example,
The Primary Key ID in the table tblStudents should be StudentID, not just ID. You will have nothing but problems with this database if you have identical Primary Key names in different tables

I find it quite common in organizational data warehouses and the like, for the primary key to be ID. Then the foreign key in another table would be StudentID. It is common enough such that I've come to expect it. I'm not sure why you feel that causes problems, unless you're talking about people who don't alias things properly when writing queries, which makes everything confusing, not just ID belonging's.

 

[bilakos93]

just for the records
this seems to be doing the job

Public Function CheckAdmissionOverlap(StartDate As Date, EndDate As Variant, StudID As Long, TableName As String, ByVal FormName As String, ByVal IDFieldName As String) As Boolean
    ' Function to check if there is an overlap with existing admission records
    Dim strSQL As String
    Dim overlapCount As Long

    ' Build the SQL string to count overlapping entries
    strSQL = "StudID = " & StudID

    ' Change to recordset (arnelgp)
    Dim db As DAO.Database, SameStudID As Boolean
    Set db = CurrentDb

    If Len(FormName) > 0 And Len(IDFieldName) > 0 Then
        Dim RecordID As Long
        RecordID = Forms(FormName).Controls(IDFieldName).Value

        With db.OpenRecordset("SELECT ID, StartDate AS tblStartDate, EndDate AS tblEndDate FROM " & TableName & " WHERE " & strSQL, dbOpenSnapshot, dbReadOnly)
            SameStudID = (.RecordCount <> 0)
            If SameStudID Then
                .MoveFirst

                Do Until .EOF
                    If ![ID] <> RecordID Then
                        If IsNull(EndDate) Or IsNull(![tblenddate]) Then
                            ' Handle the case where either frmEndDate is null or tblEndDate is null
                            If IsNull(EndDate) And IsNull(![tblenddate]) Then
                                overlapCount = overlapCount + 1
                                MsgBox "There is an overlap, please check again", vbExclamation, "OverlapCheck"
                            ElseIf Not IsNull(![tblenddate]) Then
                                If ![tblenddate] >= StartDate Then
                                    overlapCount = overlapCount + 1
                                    MsgBox "This student is already admitted on " & Format(StartDate, "dd-mm-yyyy") & ".", vbExclamation, "OverlapCheck"
                                End If
                            ElseIf Not IsNull(EndDate) Then
                                If EndDate >= ![tblstartdate] Then
                                    overlapCount = overlapCount + 1
                                    MsgBox "This student is already admitted on " & Format(EndDate, "dd-mm-yyyy") & ".", vbExclamation, "overlapcheck"
                                End If
                            End If
                        Else
                            ' No null values, use the strSQL condition
                            strSQL = "StudID = " & StudID & " " & _
                                     "AND ((StartDate <= #" & Format(EndDate, "mm/dd/yyyy") & "# AND EndDate >= #" & Format(StartDate, "mm/dd/yyyy") & "#) " & _
                                     "OR (StartDate <= #" & Format(StartDate, "mm/dd/yyyy") & "# AND EndDate >= #" & Format(EndDate, "mm/dd/yyyy") & "#))"

                            ' Check for overlap using another recordset
                            Dim hasOverlap As Boolean
                            With db.OpenRecordset("SELECT ID FROM " & TableName & " WHERE " & strSQL, dbOpenSnapshot, dbReadOnly)
                                hasOverlap = (.RecordCount <> 0)
                                If hasOverlap Then
                                    .MoveFirst
                                    Do Until .EOF
                                        If ![ID] <> RecordID Then
                                            overlapCount = overlapCount + 1
                                            MsgBox "There is an overlap. Please check again.", vbExclamation, "OverlapCheck"
                                        End If
                                        .MoveNext
                                    Loop
                                End If
                            End With
                        End If
                    End If
                    .MoveNext
                Loop
            End If
        End With
    End If

    ' Return True if there is an overlap, False otherwise
    CheckAdmissionOverlap = (overlapCount > 0)
End Function