Dear All Seniors & Masters,
I'm a beginner at VBA.
This current code was prevented/checked when updated on any data even data entry has no duplicates.
If data entry is put continuous/new entry, it's ok, code is working.
If I was updated on any old data, Msgbox shown duplicate found. So I can not put second time data entry.
Could you please check and guide me that how can i change my code ?
Table name = tbl_m_gui/Form name = VGAssign
field name1 = GuideCode/txtGuideCode
field name2 = DateFrom/txtDateFrom
field name3 = DateFrom/txtDateTo
field name4 = Time(lookup list)/txtTime
field name5,6,7,8.., = ........
Thanks & Best regards,
ASK
I'm a beginner at VBA.
This current code was prevented/checked when updated on any data even data entry has no duplicates.
If data entry is put continuous/new entry, it's ok, code is working.
If I was updated on any old data, Msgbox shown duplicate found. So I can not put second time data entry.
Could you please check and guide me that how can i change my code ?
Table name = tbl_m_gui/Form name = VGAssign
field name1 = GuideCode/txtGuideCode
field name2 = DateFrom/txtDateFrom
field name3 = DateFrom/txtDateTo
field name4 = Time(lookup list)/txtTime
field name5,6,7,8.., = ........
Code:
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim strSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb()
strSQL = "SELECT tbl_gui.GuideCode, tbl_gui.Time, tbl_gui.DateFrom, tbl_gui.DateTo from tbl_gui WHERE GuideCode = '" & Me.txtGuideCode & "' AND Time = '" & Me.txtTime & "' order by DateFrom "
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not rs.EOF Then
While Not rs.EOF
If [COLOR=Blue](rs("DateFrom").Value <= Me.txtDateFrom And rs("DateTo").Value >= Me.txtDateFrom) Or _
(rs("DateFrom").Value <= Me.txtDateTo And rs("DateTo").Value >= Me.txtDateTo)[/COLOR] Then
[COLOR=Blue]MsgBox "Overlapping Date Found, please check", , "Duplicate Guide detected"
[COLOR=Purple]Me.Undo[/COLOR][/COLOR]
Exit Sub
End If
rs.MoveNext
Wend
Else
MsgBox "Data Submitted", , "No Duplicate Guide detected"
End If
rs.Close
db.Close
End Sub
ASK
Last edited: