Duplicate message problem in MS Access VBA code - vba

Still new to coding in MS Access. Need some assistance.
What I want to be able to do is capture a person in my table multiple based off the request date however if the request is the same date I want my message for duplicate record to show. Right now my code is looking at first name and last name only and if I enter the same person in on my form with a different date it thinks its a duplicate. Need to fix this. below is my code. I want to add something in this to look at the date as well as the names. The field for the date is Date_of_DMIPasswordReset
Private Sub cmdSave_Click()
If DCount("*", "Tbl_DMIPasswordResets", "FirstName = '" & Me.txtFirstName & "' AND LastName = '" &
Me.txtLastName & "'") > 0 Then
If MsgBox(Me.txtFirstName & " " & Me.txtLastName & " Is already in the DMI Password Reset table
to be approved" & vbNewLine & _
"Do You want to Delete this record", vbQuestion + vbYesNo, "Duplicate Entry") = vbYes Then
Me.Undo
End If
Else
Form_BeforeUpdate (0)
If blnSaveRecord Then
Me.Dirty = False
MsgBox "DMI Password Reset for this Employee Saved", vbInformation
Me.cboEmpLookup.Requery
End If
End If
End Sub

Related

how to find a data from a table and validate with text if its match confirm data is exist

A table has a column "Code" and trying to match from access form text box if the data in the textbox match with data in column "Code" it has to say yes data is exist.. request your kind assistance.i tried but seems to be wrong
ecode = Me.code.Text
Dim dupsql
dupsql = "SELECT Code FROM [BookingTable]WHERE Code ='" & ecode & "'"
'Debug.Print dupsql
If dupsql = ecode Then
MsgBox " The Entered Code is already in Use! ", vbInformation
end if
A SELECT SQL statement is used to open a recordset object. Your code does not open a recordset object. Just referencing variable that holds SQL string does nothing.
Don't need a recordset object. DLookup domain aggregate function can serve.
If Not IsNull(DLookup("Code", "BookingTable", "Code='" & Me.Code & "'") Then
MsgBox " The Entered Code is already in Use! ", vbInformation
End If
Or DCount.
If DCount("*", "BookingTable", "Code='" & Me.Code & "'") > 0 Then
I have used the following code and it works.
ecode = Me.code.Text
Dim datafind As String
datafind = Nz(DLookup("[Code]", "BookingTable", "Code = '" & ecode & "'"), 0)
Debug.Print datafind
If datafind = ecode Then
MsgBox " The Entered Code is already in Use! ", vbInformation
end if

How to make listbox display search results based on input in form?

I got a table called "dbInventory" with "ID, InvName, InvQuantity, InvType" and a entry form matching these columns.
What I'm trying to achieve is to have the listbox start displaying search results based on the input.
(My ID column contains barcodes, not autonumbers)
So for instance, if I scan a barcode for an item I already put in the table some other time, I would like it to appear on the listbox right away.
How would one go about that?
It seems like you are wanting to deal with two different methods of entry - either by scanning a barcode (which would give you the entire barcode) or by the user typing the barcode in.
I would suggest using two controls in tandem - a text box, where the user can either scan a bar code or else type in the start of the barcode (and delete typed in data), and then a list box where matches are displayed.
You can use the text box's Change event to get the .Text property and use that as the basis of the list box's RowSource:
Private Sub txtSearch_Change()
On Error GoTo E_Handle
If Not (IsNull(Me!txtSearch.Text)) Then
Me!lstInventory.RowSource = "SELECT ID, InvName, InvQuantity, InvType FROM dbInventory WHERE ID LIKE '" & Me!txtSearch.Text & "*' ORDER BY ID ASC;"
Else
Me!lstInventory.RowSource = "SELECT ID, InvName, InvQuantity, InvType FROM dbInventory ORDER BY ID ASC;"
End If
sExit:
On Error Resume Next
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "frmInventory!txtSearch_Change", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
I'm not sure whether scanning a barcode into the text box will trigger the OnChange event - it should do!!
If you are now using 2 different controls to search (part matching on ID and Name) then you should use a small procedure that creates the RowSource of the ListBox as needed, and then call it from the OnChange event of either text box. Something like the code below should get you started:
Private Sub txtSearchID_Change()
Call sSearchForInventory(Nz(Me!txtSearchID.Text, ""), Nz(Me!txtSearchName.Value, ""))
End Sub
Private Sub txtSearchName_Change()
Call sSearchForInventory(Nz(Me!txtSearchID.Value, ""), Nz(Me!txtSearchName.Text, ""))
End Sub
Sub sSearchForInventory(strID As String, strName As String)
On Error GoTo E_Handle
Dim strSQL As String
If Len(strID) > 0 Then
strSQL = " AND ID LIKE '" & strID & "*' "
End If
If Len(strName) > 0 Then
strSQL = strSQL & " AND InvName LIKE '" & strName & "*' "
End If
If Left(strSQL, 4) = " AND" Then
strSQL = "WHERE " & Mid(strSQL, 6)
End If
Me!lstInventory.RowSource = "SELECT ID, InvName, InvQuantity, InvType FROM dbInventory " & strSQL & " ORDER BY ID ASC;"
Me!lstInventory.Requery
sExit:
On Error Resume Next
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sSearchForInventory", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Notice that you need to use the .Text property of the control that is being changed, but the .Value property of the other control.
Regards,

Prevent data duplication with condition

I want to setup a data duplication check on a text box which is used to input serial numbers.
If the entered serial number is already found in the database, it should call a MsgBox to alert the user before clearing the value in the text box.
However, if the entered serial number contains "RW", the check should be disabled.
Private Sub Serial_Number_AfterUpdate()
Dim NewSerialNumber As String
Dim stLinkCriteria As String
NewSerialNumber = Me.Serial_Number.Value
stLinkCriteria = "[Serial_Number] = " & "'" & NewSerialNumber & "'"
If Me.Serial_Number = DLookup("[Serial_Number]", "Esagon_End", stLinkCriteria) Then
MsgBox "This serial number, " & NewSerialNumber & ", has already been entered into the database." _
& vbCr & vbCr & "Please check the serial number again.", vbI, "Duplicate information"
Me.Undo
End If
End Sub
If this cannot be done with VBA I'm open to other methods like queries. Thank you.
Looking at what you have asked, I think this is what you are looking for. If it isn't then leave a comment and I'll try to update my answer.
Private Sub Serial_Number_AfterUpdate()
'If it doesn't contain "RW"
If InStr(Me.Serial_Number, "RW") = 0 Then
'If serial number not in the database
If DCount("*", "Esagon_End", "Serial_Number = '" & Me.Serial_Number & "'") > 0 Then
'Alert user and blank the text box
Call MsgBox("The serial number " & Me.Serial_Number & " is already in the database." _
& vbCrLf & vbCrLf & "Please check the serial number you are entering.", _
vbInformation, "Duplicate Serial")
Me.Serial_Number = ""
End If
End If
End Sub

MS Access VBA Ranged Dates with BETWEEN or single entry with in Text Boxes

I'm looking for some assistance on this Look up code I managed to put together.
If Me.txtStartDate > "" And Me.txtEndDate > "" Then
varWhere = varWhere & "[CompletionDate] BETWEEN #" & Me.txtStartDate & "# AND #" & Me.txtEndDate & "#"
ElseIf Me.txtStartDate > "" And Me.txtEndDate Is Nothing Then
varWhere = varWhere & "[CompletionDate] = """" & Me.txtStartDate & " * "" And ""
ElseIf Me.txtStartDate Is Nothing And Me.txtEndDate > "" Then
MsgBox "Please Input a Start Date", vbOKOnly, Error
End If
I feel like the code itself is self explanatory of my goals. However I'm wanting to allow the user to input into Me.txtStartDate & Me.txtEndDate giving the range. Also, Allowing the user to just input into Me.txtStartDate for a single date. I have attempted combining the two Along with a message box if they input into end date alone.
Its not working for me, I can get either or working.
My Question is "How do I combine these three statements, so they work in a conditional statement way?"
Anything helps.
I'm not sure what you're trying to do. I like to use datepickers.
Private Sub Form_Open(Cancel As Integer)
Me.DTPickerStart.DefaultValue = "Date()"
Me.DTPickerEnd.DefaultValue = "Date()"
Then I'd do something like this.
If (Nz(Me.Me.txtStartDate.Value) = "") Then
MsgBox "Please select a Start Date.", vbCritical + vbOKOnly, "Error"
ElseIf (Nz(Me.txtEndDate.Value) = "") Then
MsgBox "Please select a End Date.", vbCritical + vbOKOnly, "Error"
Else
DoCmd.OpenReport "XYZRpt", acViewPreview
Or you could do..
DoCmd.OpenQuery "Passthroughquery" that links to an SQL procedure. I'm not
sure what you're trying to do though.
End If

Prevent Duplicate Entries VBA

First off I am a bit of a novice when its comes to VBA, so everything I do is a bit of hit and miss but normally I eventually figure out the problem.
However this time I have been stuck for days and can't seem to find the issue!
I have the following form and subforms with the below structure. (Access2013)
Main Form [Job Number]
Subform [Out2] (this is where a user scans a barcode into the relevant field)
Subform [DS] (this is where the scanned barcode from [Out2] creates a new record)
Subform [DS] fields : Id, Job No, BarCode, Description, Date, User
What I am trying to achieve with the code below, is in 'The Before Update' event of the [DS] BarCode field, the Dcount function will check the list of Barcodes already entered in the subform container [DS], and if there
is more than one it will undo the duplicate entry. Unfortunately nothing is happening when a duplicate entry is entered.
(not even errors)
P.S. Setting the table (No Duplicates) thing will not work for this DB.
Private Sub BarCode_BeforeUpdate(Cancel As Integer)
Dim BarCode As String
Dim strLinkCriteria As String
Dim rsc As DAO.Recordset
Set rsc = Me.RecordsetClone
BarCode = Me.BarCode.Text
strLinkCriteria = "[Barcode]=" & "'" & Replace(Me![BarCode], "'", "''")
'Check Items Subform for duplicate BarCode
If DCount("BarCode", "Forms![Job Number]![DS]", strLinkCriteria) > 0 Then
'Undo duplicate entry
Me.Undo
'Message box warning of duplication
MsgBox "Warning Item Title " _
& BarCode & " has already been entered." _
& vbCr & vbCr & "You will now been taken to the record.", _
vbInformation, "Duplicate Information"
'Go to record of original Title
rsc.FindFirst strLinkCriteria
Me.Bookmark = rsc.Bookmark
End If
Set rsc = Nothing
End Sub
Here is how to handle this:
Private Sub BarCode_BeforeUpdate(Cancel As Integer)
Dim rsc As DAO.Recordset
Dim BarCode As String
Dim Criteria As String
Set rsc = Me.RecordsetClone
BarCode = Nz(Me!BarCode.Value)
Criteria = "[Barcode] = '" & Replace(BarCode, "'", "''") & "'")
rsc.FindFirst Criteria
Cancel = Not rsc.NoMatch
If Cancel = True Then
' Message box warning of duplication
MsgBox "Warning Item Title " _
& BarCode & " has already been entered." _
& vbCrLf & vbCrLf & "You will now been taken to the record.", _
vbInformation, "Duplicate Information"
' Go to record of original Title
Me.Bookmark = rsc.Bookmark
End If
Set rsc = Nothing
End Sub