Prevent duplicates using DLookup, but can't edit record without error?

[Casey Sanders]

Ok, here is what I'm trying to accomplish:

I have a table of products "tbl_Products" which stores all of my product information (Product_ID, Product_Code, Description, Pricing, etc.). The "Product_ID" is an autonumber field and the "Product_Code" is the code we use internally. I want to make sure that when new products are entered, the "Product_Code" is not a duplicate. Normally, I could accomplish this by indexing the field with No Duplicates, however this is not a text field and is calculated from 3 other tables. Each "Product_Code" has a "Prefix", "Style_Number" and "Suffix" that determines the actual "Product_Code". For example: 3 product codes could be "WC 548 HR", "WC 408 X" and "CS 548 HRV". So it IS important to keep the setup this way. Many products will have the same "Prefix" with varying "Style_Number"s and "Suffix"es, as many products may share the same "Style_Number" but not the same "Prefix" / "Suffix".

I have 3 Tables: "tbl_Product_Prefixes", "tbl_Product_Style_Numbers", and "tbl_Product_Suffixes", which all have a ONE-TO-MANY relationship with "tbl_Products". "tbl_Products" uses "Prefix" from "tbl_Product_Prefixes", "Style_Number" from "tbl_Product_Style_Numbers", and "Suffix" from "tbl_Product_Suffixes" and has a field titled "Product_Code" which is calculated by combing all 3. This is the field I need to ensure is not duplicated (and since it is calculated there is no index option to not allow duplicates).

I have tried many ways to code it in many different Events but can't get it to work properly. Here is the code I have so far:

Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_Exit_this_sub
Dim x As Variant
    x = DLookup("[Product_Code]", "[tbl_Products]", "[Product_Code]='" & [Forms]![frm_Products]![Product_Code] & "'")
   If Not IsNull(x) Then
      Beep
      MsgBox "That product code already exists.  Please enter a unique product code.", vbOKOnly, "Duplicate Value"
      Cancel = True
    End If
Exit_this_sub:
    Exit Sub
Err_Exit_this_sub:
    MsgBox Error$
    Resume Exit_this_sub
End Sub

What works correctly:
When the form loads to add a new product, I have 3 combo boxes (Prefix, Style Number, Suffix) from which I can select the individual entries to make the combined "Product_Code". When all 3 are selected, it populates the correct product code. When saving the record, if the "Product_Code" exists in "tbl_Products" it will give the error "That product code already exists. Please enter a unique product code." All other form data entered remains in tact and I can then change the product code to something unique and save the record.

What does not work correctly:
When editing any field on the form of a record that already exists, I get the "..product code already exists.." error when saving. I can change the product code to something unique, save it, then change it back to what it should be, but this will be a huge inconvenience when updating pricing,descriptions, etc. on thousands of products.

Is there any way to alter the code so that it knows NOT to check the current record when looking for duplicate "Product_Code"s?

Any help is greatly appreciated!

Thanks,
Casey

[Casey Sanders]

As a side note, I had this coded a different way (on the combo boxes themselves instead of on the form before update) and did not have the problem mentioned above (regarding editing prices, etc.) Below is the code I used and it would notify you immediately when you changed the prefix, style number, or suffix, but the main problem here is that it gives the error, but can save the record anyway, PLUS when selecting the info for the product code it would give false errors (for instance if I already had a product code "WC 402" with no suffix--because most products actually do not require a suffix-- and needed to add "WC 402 HR"...when I selected the prefix "WC" and the style number "402" it would give the error without giving me a chance to select the suffix "HR"....not to mention this code is bulky...

Private Sub Prefix_AfterUpdate()
On Error GoTo Err_Exit_this_sub
Dim x As Variant
    x = DLookup("[Product_Code]", "[tbl_Products]", "[Product_Code]='" & [Forms]![frm_Products]![Product_Code] & "'")
   If Not IsNull(x) Then
      Beep
      MsgBox "That value already exists", vbOKOnly, "Duplicate Value"
      Cancel = True
      [Forms]![frm_Products]![Prefix] = ""
      [Forms]![frm_Products]![Style_Number] = ""
      [Forms]![frm_Products]![Suffix] = " "
   End If
Exit_this_sub:
    Exit Sub
Err_Exit_this_sub:
    MsgBox Error$
    Resume Exit_this_sub
End Sub




Private Sub Style_Number_AfterUpdate()
On Error GoTo Err_Exit_this_sub
Dim x As Variant
    x = DLookup("[Product_Code]", "[tbl_Products]", "[Product_Code]='" & [Forms]![frm_Products]![Product_Code] & "'")
   If Not IsNull(x) Then
      Beep
      MsgBox "That value already exists", vbOKOnly, "Duplicate Value"
      Cancel = True
      [Forms]![frm_Products]![Prefix] = ""
      [Forms]![frm_Products]![Style_Number] = ""
      [Forms]![frm_Products]![Suffix] = " "
   End If
Exit_this_sub:
    Exit Sub
Err_Exit_this_sub:
    MsgBox Error$
    Resume Exit_this_sub
End Sub


Private Sub Suffix_AfterUpdate()
On Error GoTo Err_Exit_this_sub
Dim x As Variant
    x = DLookup("[Product_Code]", "[tbl_Products]", "[Product_Code]='" & [Forms]![frm_Products]![Product_Code] & "'")
   If Not IsNull(x) Then
      Beep
      MsgBox "That value already exists", vbOKOnly, "Duplicate Value"
      Cancel = True
      [Forms]![frm_Products]![Prefix] = ""
      [Forms]![frm_Products]![Style_Number] = ""
      [Forms]![frm_Products]![Suffix] = " "
   End If
Exit_this_sub:
    Exit Sub
Err_Exit_this_sub:
    MsgBox Error$
    Resume Exit_this_sub
End Sub

[ssanfu]

Casey,

So the problem is if you are adding a new record or editing an existing record. Using that, I modified your code:

Private Sub Form_BeforeUpdate(Cancel As Integer)
   On Error GoTo Err_Exit_this_sub

   Dim x As Variant
   Dim intnewrec As Integer
   Dim criteria As String

   intnewrec = Me.NewRecord
   If intnewrec = True Then
      '      MsgBox "New record"
      'check all records
      criteria = "[Product_Code]='" & [Forms]![frm_Products]![Product_Code] & "'"
   Else   ' existing record
      '      MsgBox "Existing record  /  PK = " & Me.ID
      'check all records EXCEPT the current record
      criteria = "[Product_Code]='" & [Forms]![frm_Products]![Product_Code] & "' AND [Product_ID] <> " & Me.[Product_ID]
   End If

   x = DLookup("[Product_Code]", "[tbl_Products]", criteria)
   If Not IsNull(x) Then
      Beep
      MsgBox "That product code already exists.  Please enter a unique product code.", vbOKOnly, "Duplicate Value"
      Cancel = True
   End If


Exit_this_sub:
   Exit Sub

Err_Exit_this_sub:
   MsgBox Error$
   Resume Exit_this_sub

End Sub

The changes are in BLUE (as if you couldn't tell )
I put the criteria string into a separate variable because it is easier to step through the code to see if the criteria is what you would expect/want.


This is untested, but I think it should work.....