Solved Prevent Duplicate Entry with Multiple DLook Up's (1 Viewer)

[Squid1622]

So I'm attempting to adopt some code that I came across in an effort to prevent people from double entering invoices. I think I understand the basic premise which is to use the DLookup to compare what has been entered to values already existing in the table and if it matches, then prevent the invoice from being entered.

The code I found uses only one criteria to prevent duplicate entry. However, I need to use 4 criteria to prevent an entry (VendorID, InvoiceDate, InvoiceNum, and Amount). In addition, I'm using a combobox to allow the user to select the VendorID. Here is what I have so far.

 Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim Vendor As Variant
Dim Amount As Variant
Dim InvoiceDate As Variant
Dim InvoiceNum As Variant
 Vendor = DLookup("[VendorID]", "tblMaintenance", "[VendorID] = '" & Me.VendorID & "'")
Amount = DLookup("[Amount]", "tblMaintenance", "[Amount] ='" & Me.Amount & "'")
InvoiceDate = DLookup("[InvoiceDate]", "tblMaintenance", "[InvoiceDate] ='" & Me.InvoiceDate & "'")
InvoiceNum = DLookup("[InvoiceNum]", "tblMaintenance", "[InvoiceNum] ='" & Me.InvoiceNum & "'")
 'Answer = DLookup("[SocialSecurity]", "tblApplicant", "[SocialSecurity] = '" & Me.SocialSecurity & "'")
'if Not IsNull(Answer) Then
'MsgBox "Duplicate Social Security Number Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
 
'Cancel = True
'Me.SocialSecurity.Undo
 
If Not IsNull(Vendor) Then
MsgBox "Duplicate Vendor Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
 
Cancel = True
Me.VendorID.Undo
 
Else:
End If
 End Sub

The first problem I get when I run this is a datatype mis-match on the VendorID in the DLookup. After I fix this problem I know there will be some sort of If statement or Loop to allow me to use all 4 DLookup's, but I need to get through this initial problem first and understand what I'm doing wrong with the DLookup itself. The commented portion of the code is the original code I'm working from.

Table Fields are set as follows, VendorID is an integer, Amount is set as current, InvoiceDate is a date/time, and InvoiceNum is text

 

[Ranman256]

a query would do the same thing. if they enter invoice data into boxes, then open a query to see if it exists. if so, stop.

if not, post the data to the table

 

[Squid1622]

Which would be quicker to run? The table right now stands at about 90,000 records. Would the query have to run through every record to determine if it was a duplicate? Would the VBA code run faster?

 

[Squid1622]

So here's some code I actually got to work.

 Private Sub Form_BeforeUpdate(Cancel As Integer)
 Dim Vendor As Variant
Dim Amount As String
Dim InvoiceDate As Variant
Dim InvoiceNum As String
Dim Answer As String
 'Vendor = DLookup("[VendorID]", "tblMaintenance", "[VendorID] = " & Me.VendorID)
Amount = DLookup("[Amount]", "tblMaintenance", "[Amount] =" & Me.Amount)
InvoiceDate = DLookup("[InvoiceDate]", "tblMaintenance", "[InvoiceDate] =" & Me.InvoiceDate)
InvoiceNum = DLookup("[InvoiceNum]", "tblMaintenance", "[InvoiceNum] ='" & Me.InvoiceNum & "'")
 Answer = Amount & InvoiceDate & InvoiceNum
If Not IsNull(Answer) Then
               MsgBox "Duplicate Invoice Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
               Cancel = True
                Me.Amount.Undo
                Me.InvoiceDate.Undo
                Me.InvoiceNum.Undo
                Me.VendorID.Undo
           Else:
End If
End Sub

I would love to get the VendorID part of this working. The VendorID is input by the user using a combo box. When I've attempted to make the VendorID part of the Answer variable, the code does not work. Does anyone know why?

 

[Minty]

Is the Vendor ID a numeric or text value ? If it is text you need to enclose it in quotes e.g.

Vendor = DLookup("[VendorID]", "tblMaintenance", "[VendorID] = [COLOR="red"]'[/COLOR]" & Me.VendorID & [COLOR="Red"]"'"[/COLOR])

And a single query would run much quicker than 4 separate DLookups

 

[Squid1622]

The VendorID is numeric. I have a combo box on the form that inputs the VendorID for a specific Vendor into the VendorID field on the form.

 

[Squid1622]

Next Attempt:

 Private Sub Form_BeforeUpdate(Cancel As Integer)
 Dim Invoice As Variant
 Invoice = DCount("*", "tblMaintenance", _
                "[Amount]=" & Me.Amount & "And [InvoiceDate]=" & Me.InvoiceDate & _
                "And [InvoiceNum]='" & Me.InvoiceNum & "'")
 
If Not IsNull(Invoice) Then
    MsgBox "Duplicate Invoice Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
    Cancel = True
    Me.Amount.Undo
    Me.InvoiceDate.Undo
    Me.InvoiceNum.Undo
    Me.VendorID.Undo
Else:
End If
End Sub

I decided to try and use a DCount to narrow things down. The code above will not let me make any new entries, new or duplicate. :banghead:

 

[Squid1622]

Is the Vendor ID a numeric or text value ? If it is text you need to enclose it in quotes e.g.

Vendor = DLookup("[VendorID]", "tblMaintenance", "[VendorID] = [COLOR=red]'[/COLOR]" & Me.VendorID & [COLOR=red]"'"[/COLOR])

And a single query would run much quicker than 4 separate DLookups

How do I set up the query?

 

[Squid1622]

a query would do the same thing. if they enter invoice data into boxes, then open a query to see if it exists. if so, stop.

if not, post the data to the table

Could you provide steps/coding to get this done?

 

[Minty]

DCount won't work as you have programmed it as it will always a value - you should be testing for 0 as the result.

The query is exactly the same as your DCount and tbh the DCount will be much quicker than all the DLookups. Air code for your query in VBA attached to the form;

Select * from tblMaintenance WHERE   [Amount]= " & Me.Amount & " And [InvoiceDate]= " & Me.InvoiceDate & "  And [InvoiceNum]= '" & Me.InvoiceNum & "'"

 

[Squid1622]

DCount won't work as you have programmed it as it will always a value - you should be testing for 0 as the result.

The query is exactly the same as your DCount and tbh the DCount will be much quicker than all the DLookups. Air code for your query in VBA attached to the form;

Select * from tblMaintenance WHERE   [Amount]= " & Me.Amount & " And [InvoiceDate]= " & Me.InvoiceDate & "  And [InvoiceNum]= '" & Me.InvoiceNum & "'"

I replaced the DCount with the query statement above and I also set my if statement to check if the Invoice Variable was greater than 0. I still can't enter any records, new or duplicate. Here is my code.

 Private Sub Form_BeforeUpdate(Cancel As Integer)
 Dim Invoice As Variant
 Invoice = "Select [MaintenanceInvoiceID] from tblMaintenance WHERE   [Amount]= " & Me.Amount & " And [InvoiceDate]= " & Me.InvoiceDate & "  And [InvoiceNum]= '" & Me.InvoiceNum & "'"
 Debug.Print Invoice
 If Invoice > 0 Then
    MsgBox "Duplicate Invoice Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
    Cancel = True
    Me.Amount.Undo
    Me.InvoiceDate.Undo
    Me.InvoiceNum.Undo
    Me.VendorID.Undo
Else:
End If
End Sub

 

[Minty]

Sorry we are confusing you. You can't use a Select query like that. You have to open a recordset using that SQL string. It's a bit overkill but a good technique to learn. Try this;

Private Sub Form_BeforeUpdate(Cancel As Integer)

	 Dim sSql as String
	 Dim rs as Recordset
  
 sSql = "Select [MaintenanceInvoiceID] from tblMaintenance WHERE [Amount]= " & Me.Amount & " And [InvoiceDate]= #" & Format("yyyy/mm/dd", Me.InvoiceDate & "#  And [InvoiceNum]= '" & Me.InvoiceNum & "' ;"
 
 Debug.Print sSql 
  
 Set rs = CurrentDb.OpenRecordset (sSql, dbOpenSnapshot)
 
 rs.MoveLast
 
 If rs.RecordCount > 0 Then
    MsgBox "Duplicate Invoice Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
    Cancel = True
    Me.Amount.Undo
    Me.InvoiceDate.Undo
    Me.InvoiceNum.Undo
    Me.VendorID.Undo
End If

rs.close
Set rs = Nothing

End Sub

 

[Squid1622]

Sorry we are confusing you. You can't use a Select query like that. You have to open a recordset using that SQL string. It's a bit overkill but a good technique to learn. Try this;

Private Sub Form_BeforeUpdate(Cancel As Integer)

     Dim sSql as String
     Dim rs as Recordset
  
 sSql = "Select [MaintenanceInvoiceID] from tblMaintenance WHERE [Amount]= " & Me.Amount & " And [InvoiceDate]= #" & Format("yyyy/mm/dd", Me.InvoiceDate & "#  And [InvoiceNum]= '" & Me.InvoiceNum & "' ;"
 
 Debug.Print sSql 
  
 Set rs = CurrentDb.OpenRecordset (sSql, dbOpenSnapshot)
 
 rs.MoveLast
 
 If rs.RecordCount > 0 Then
    MsgBox "Duplicate Invoice Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
    Cancel = True
    Me.Amount.Undo
    Me.InvoiceDate.Undo
    Me.InvoiceNum.Undo
    Me.VendorID.Undo
End If

rs.close
Set rs = Nothing

End Sub

I had a feeling at the beginning that I would need to loop through a recordset at some point, I just didn't know when, where, or how. If you haven't already suspected, I'm not altogether proficient with using sql in vba. When I copied the code over to access, there appears to be an issue with the sql statement. It's asking me for a list separator or ). I tried to figure out where the issue was, but I could be at it forever.

 

[Squid1622]

So I removed the date field from the equation and replaced it with the vendor ID. It works as anticipated when the record is a duplicate. However, when I enter a new record I get a "Run time error 3021, No Current Record." It says the issue is at the part highlighted in red.

 Private Sub Form_BeforeUpdate(Cancel As Integer)
      Dim sSql As String
     Dim rs As Recordset
  
 sSql = "Select [MaintenanceInvoiceID] from tblMaintenance WHERE   [VendorID]= " & Me.VendorID & " AND [Amount]= " & Me.Amount & " And [InvoiceNum]= '" & Me.InvoiceNum & "'"
 
 Debug.Print sSql
  
 Set rs = CurrentDb.OpenRecordset(sSql, dbOpenSnapshot)
 
 [COLOR=red]rs.MoveLast[/COLOR]
 
 If rs.RecordCount > 0 Then
    MsgBox "Duplicate Invoice Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
    Cancel = True
    Me.Amount.Undo
    Me.InvoiceDate.Undo
    Me.InvoiceNum.Undo
    Me.VendorID.Undo
End If
 rs.Close
Set rs = Nothing
 End Sub

 

[Minty]

Okay - we probably need to account for no records, sorry it was created in a hurry - try;

Private Sub Form_BeforeUpdate(Cancel As Integer)
      Dim sSql As String
     Dim rs As Recordset
  
 sSql = "Select [MaintenanceInvoiceID] from tblMaintenance WHERE   [VendorID]= " & Me.VendorID & " AND [Amount]= " & Me.Amount & " And [InvoiceNum]= '" & Me.InvoiceNum & "'"
 
 Debug.Print sSql
  
 Set rs = CurrentDb.OpenRecordset(sSql, dbOpenSnapshot)
 
If Not rs.EOF Then 
  rs.MoveLast
 
  If rs.RecordCount > 0 Then
    MsgBox "Duplicate Invoice Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
    Cancel = True
    Me.Amount.Undo
    Me.InvoiceDate.Undo
    Me.InvoiceNum.Undo
    Me.VendorID.Undo
  End If
End If
 rs.Close
Set rs = Nothing
 End Sub

 

[Squid1622]

That worked like a charm. In the interest of learning, would you mind (at your leisure of course) commenting the code so that I can understand a little better why it worked?

 

[Minty]

No problem - I would normally be a bit more verbose - real job and football were distracting me...

 Private Sub Form_BeforeUpdate(Cancel As Integer)
       Dim sSql As String
       Dim rs As Recordset
  
 [COLOR="SeaGreen"] 'Create the SQL query in text form , making sure that any text is surrounded by single quotes 
  'and dates are formatted in US #mm/dd/yyyy# format with the #16/06/2016# around them. 
  'I personally prefer to use concatenation rather than continuation characters when the strings get a bit long to handle. Also note that you need to put spaces at the ends of the lines. [/COLOR]
  sSql = "Select [MaintenanceInvoiceID] from tblMaintenance  "
  sSql = sSql & "WHERE [VendorID]= " & Me.VendorID & " AND [Amount]= " & Me.Amount & " " 
  sSql = sSql & "And [InvoiceNum]= '" & Me.InvoiceNum & "' ;"
  
  Debug.Print sSql 		[COLOR="seagreen"]' This will allow you to see the actual query string in the immediate window in the VBA editor - Press ctrl G to bring it up.
  				' It's one of the most useful debugging / error spotting methods.
  				' Once you get your code working simply comment it out
   
  	' Open a recordset using the query we created above, the dbOpenSnapshot means we are only taking a readonly view of the data, 
  	' it is all we need in this instance as we are only after a record count/
  [/COLOR]Set rs = CurrentDb.OpenRecordset(sSql, dbOpenSnapshot)
	
	[COLOR="seagreen"]'Check that the recordset is not at the End Of File - if it is there are no records[/COLOR]
  If Not rs.EOF Then 
  
  	[COLOR="seagreen"]' In this instance we really don't need the next statement or check because we are checking for no records but 
  	' If you are going to use the recordset then it's very good practice to move to the last and first record as recordsets 
  	' can return incorrect values - see http://allenbrowne.com/ser-29.html for more info anout recordsets and some gotcha's[/COLOR]
  rs.MoveLast
  			[COLOR="seagreen"]' Check the number of records returned, handy when you want to loop around them. Unecessary really here.[/COLOR]
  	If rs.RecordCount > 0 Then 
	     MsgBox "Duplicate Invoice Found" & vbCrLf & "Please enter again.", vbCritical + vbOKOnly + vbDefaultButton1, "Duplicate"
	     Cancel = True
	     Me.Amount.Undo
	     Me.InvoiceDate.Undo
	     Me.InvoiceNum.Undo
	     Me.VendorID.Undo
	End If
  End If
  	[COLOR="seagreen"]' Always close your recordset and reset it to nothing after you have finished with it
[/COLOR] rs.Close
 Set rs = Nothing
 
 End Sub

 

[Squid1622]

Thank you so much for all your help!