Avoid duplicate records (overlapping dates)

[bilakos93]

Hello everyone!

I've been trying to use the code below (created by chatgpt essentially)
I'm essentially trying to pop a msgbox (and not save) whenever there is a given DiagID for a given StudID on overlapping days
e.g. diagID 1 for studID 1 on 10-15 Jan (dur 6 days) already exists. User is trying to enter diagID 1 for studID 1 on 12-20 Jan (dur 9 days). This should prompt a msgbox and not save.
DiagID 2 for studID 1 on 10-15 Jan (dur 6 days) is fine.
I'm getting error 3075 on the dcount line.
Any smart ideas?

PS code also includes mandatory fields, we can ignore that bit

Thanks

Private Sub Form_BeforeUpdate(Cancel As Integer)
    Dim ctrl As Control
    Dim missingFields As String

    For Each ctrl In Me.Controls
        If TypeOf ctrl Is TextBox Or TypeOf ctrl Is ComboBox Then
            If ctrl.Tag = "Required" And IsNull(ctrl.Value) Then
                missingFields = missingFields & ctrl.Name & ", "
            End If
        End If
    Next ctrl

    If Len(missingFields) > 0 Then
        missingFields = Left(missingFields, Len(missingFields) - 2) ' Remove the trailing comma and space
        MsgBox "The following fields cannot be left blank: " & missingFields, vbExclamation, "Missing Information"
        Cancel = True ' Prevents the form from being saved
        Exit Sub ' Exit the sub to avoid further processing
    End If

    Dim StartDate As Date
    Dim EndDate As Date
    Dim Dur As Integer

    StartDate = Me.StartDate
    Dur = Me.Dur
    EndDate = StartDate + Dur - 1

    ' Check for overlapping diagnosis entry
    If DiagOverlapExists(StartDate, EndDate, Me.DiagID, Me.StudID) Then
        MsgBox "Leave overlap detected! An overlapping leave entry already exists for the selected dates and leave type."
        Cancel = True
    End If
End Sub

Function DiagOverlapExists(StartDate As Date, EndDate As Date, DiagID As Long, StudID As Long) As Boolean
    ' Function to check if an overlapping diagnosis entry exists
    Dim strSQL As String
    Dim overlapCount As Long

    ' Format dates for use in the SQL query
    Dim formattedStartDate As String
    Dim formattedEndDate As String
    formattedStartDate = Format(StartDate, "yyyy-mm-dd")
    formattedEndDate = Format(EndDate, "yyyy-mm-dd")

    ' Build the SQL string to count overlapping diagnosis entries
    strSQL = "SELECT COUNT(*) FROM tblStudDiag " & _
             "WHERE StudID = " & StudID & " AND DiagID = " & DiagID & " " & _
             "AND ((StartDate <= #" & formattedEndDate & "# AND EndDate >= #" & formattedStartDate & "#) " & _
             "OR (StartDate <= #" & formattedStartDate & "# AND EndDate >= #" & formattedEndDate & "#))"

    ' Debug statement to print the SQL query to the Immediate Window
    Debug.Print "SQL Query: " & strSQL

    Debug.Print "StudID: " & StudID
    Debug.Print "DiagID: " & DiagID
    Debug.Print "StartDate: " & Format(StartDate, "yyyy-mm-dd")
    Debug.Print "EndDate: " & Format(EndDate, "yyyy-mm-dd")

    ' Execute the SQL and retrieve the count
    overlapCount = DCount("*", "tblStudDiag", strSQL)
    Debug.Print "OverlapCount: " & overlapCount

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

 

[ebs17]

overlapCount = DCount("*", "tblStudDiag", strSQL)

The third argument for DCount is expected to be a filter, not a full SQL statement.
The filter corresponds to the WHERE part of an SQL statement without the WHERE keyword.

 

[arnelgp]

change your strSQL to:

    strSQL = "StudID = " & StudID & " AND DiagID = " & DiagID & " " & _
             "AND ((StartDate <= #" & formattedEndDate & "# AND EndDate >= #" & formattedStartDate & "#) " & _
             "OR (StartDate <= #" & formattedStartDate & "# AND EndDate >= #" & formattedEndDate & "#))"

 

[Gasman]

The more crap I see ChatGPT generate, the more I think we still need humans.

 

[bilakos93]

thank you all!
Below is my code
I'm still getting an error on the same line
Please note that there is no enddate on the form i'm using. it's enddate=dur-1
Don't know if this is what's causing the issue

Function DiagOverlapExists(StartDate As Date, Dur As Long, DiagID As Long, StudID As Long) As Boolean
    ' Function to check if an overlapping diagnosis entry exists
    Dim strSQL As String
    Dim overlapCount As Long

    ' Calculate EndDate based on StartDate and Duration
    Dim EndDate As Date
    EndDate = StartDate + Dur - 1

    ' Format dates for use in the SQL query
    Dim formattedStartDate As String
    Dim formattedEndDate As String
    formattedStartDate = Format(StartDate, "yyyy-mm-dd")
    formattedEndDate = Format(EndDate, "yyyy-mm-dd")

    ' Build the SQL string to count overlapping diagnosis entries
    strSQL = "StudID = " & StudID & " AND DiagID = " & DiagID & " " & _
         "AND ((StartDate <= #" & Format(EndDate, "yyyy-mm-dd") & "# AND EndDate >= #" & Format(StartDate, "yyyy-mm-dd") & "#) " & _
         "OR (StartDate <= #" & Format(StartDate, "yyyy-mm-dd") & "# AND EndDate >= #" & Format(EndDate, "yyyy-mm-dd") & "#))"

    ' Debug statement to print the SQL query to the Immediate Window
    Debug.Print "SQL Query: " & strSQL

    Debug.Print "StudID: " & StudID
    Debug.Print "DiagID: " & DiagID
    Debug.Print "StartDate: " & Format(StartDate, "yyyy-mm-dd")
    Debug.Print "EndDate: " & Format(EndDate, "yyyy-mm-dd")

    ' Execute the SQL and retrieve the count
    overlapCount = DCount("*", "tblStudDiag", strSQL)
    Debug.Print "OverlapCount: " & overlapCount

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

 

[arnelgp]

maybe change Enddate on the code:

EndDate = DateAdd("d", Dur - 1, StartDate)

then your strSQL:

   ' Build the SQL string to count overlapping diagnosis entries
    strSQL = "StudID = " & StudID & " AND DiagID = " & DiagID & " " & _
         "AND ((StartDate <= #" & formattedEndDate & "# AND EndDate >= #" & formattedStartDate  & "#) " & _
         "OR (StartDate <= #" & formattedStartDate  & "# AND EndDate >= #" &formattedEndDate & "#))"

 

[bilakos93]

thank you!
I'm still getting an error though
This time 2471, the expression you entered as a query parameter produced this error: EndDate
And then it highlights the dcount line. I'm uploading the db if it helps

 

[arnelgp]

which Form?

 

[bilakos93]

which Form?

frmStudDiag

 

[arnelgp]

sorry, you don't have EndDate field in your table:
change some of the code to this:

...
...
...
    formattedStartDate = Format(StartDate, "\#mm\/dd\/yyyy\#")
    formattedEndDate = Format(EndDate, "\#mm\/dd\/yyyy\#")

   ' Build the SQL string to count overlapping diagnosis entries
    strSQL = "StudID = " & StudID & " AND DiagID = " & DiagID & " " & _
         "AND ((StartDate <= " & formattedEndDate & " AND (StartDate + Dur - 1) >= " & formattedStartDate & ") " & _
         "OR (StartDate <= " & formattedStartDate & " AND (StartDate + Dur - 1) >= " & formattedEndDate & "))"
...
...
...

 

[bilakos93]

that's the one!
thank you very much!!

 

[bilakos93]

hello again

everything works fine apart from a small detail
when editing records the warning box pops up as it recognises the record being edited overlapped by the new one (which are essentially the same)
I could add a line excluding the current record from the function but this may create overlapping records (i'm guessing)
Is there any way to work around that?

thanks

 

[arnelgp]

upload your new db and i will have a look.

 

[bilakos93]

thank you

 

[arnelgp]

see and test this:

 

[arnelgp]

i noticed that the "showing" on the subform data sometimes work.. and sometimes not, so
i modified some code.

 

[AccessBlaster]

The more crap I see ChatGPT generate, the more I think we still need humans.

It's still an infant, it will eventually learn and remember the corrected answer.

 

[bilakos93]

would you mind explaining why you put a timerinterval on a few instances?

 

[arnelgp]

if you can see on the VBA, i put the TimerInterval to the Form/Combobox Undo events.
this is because the Event (Undo) is a Validation Event where you can Cancel whatever you have
modified on the Form/Control. Now when you Undo, the last value of the control is still intact
until you leave the event procedure. Therefore assigning a value to a textbox, txtID using the combo, cboStudID
on the Undo Event will result of the Same Value being assigned by the combo.
The Timer will guarantee that the value of cboStudID is different because we are calling if 0.01 seconds
after we Leave the Undo Event.