Results 1 to 5 of 5
  1. #1
    Join Date
    Jun 2010
    Posts
    186

    Unanswered: Defining duplicate entries - Access 07 forms

    I have 2 text boxes that I need to screen for duplicates. One of them does not allow duplicates (txtAccountName), so I created a message box that warns the user & prevents continuing through the form. The second one does allow them (STREET_ADDRESS)
    Does anyone know of a way to modify this syntax so that the msg box is a warning that duplicates exist - but allow duplicate entries in street address?



    I have this code on it now - this is exactly what is on txtAccountName:

    Private Sub STREET_ADDRESS_BeforeUpdate(Cancel As Integer)

    If DCount("*", "ACCTTABLE21109", "STREET_ADDRESS = '" & Me.Street_Address & "'") > 0 Then

    MsgBox Me.Street_Address & " already exists. Click Show Matches to see other accounts at this address."

    Cancel = True

    btnMatchAddress.Visible = True

    End If



    End Sub



    I have an invisible (open report)button that appears when there is a duplicate - except it gets stuck in the MsgBox since it is trying to stop the duplicate entry



    any help would be greatly appreciated!

    thanks

  2. #2
    Join Date
    May 2005
    Location
    Nevada, USA
    Posts
    2,888
    Provided Answers: 6
    The

    Cancel = True

    is what stops the data from updating, so taking that out should allow the entry.
    Paul

  3. #3
    Join Date
    Jun 2010
    Posts
    186
    Hi Paul - I have tested this data over and over and thought it worked. What you've told me is working - where it will let me through like I wanted....but I tried it again today and it seems to be firing msgbox no matter what I enter. It tells me that eveything is a duplicate. So I can't figure out where I've gone wrong - two duplicate entry test events on two different controls on the same form.....one works, one doesn't

    Fires when there is a match:
    Private Sub ACCOUNT_BeforeUpdate(Cancel As Integer)
    If DCount("*", "ACCTTABLE21109", "ACCOUNT = '" & Me.ACCOUNT & "'") > 0 Then
    MsgBox Me.ACCOUNT & " already exists. DO NOT DUPLICATE. Return cold call sheet to salesman."
    Cancel = True
    Me.Undo
    End If

    End Sub


    Fires every entry:
    Private Sub STREET_ADDRESS_BeforeUpdate(Cancel As Integer)
    If DCount("*", "ACCTTABLE21109", "STREET_ADDRESS = '" & Me.Street_Address & "'") > 0 Then
    MsgBox Me.Street_Address & " already exists. Click Show Matches to see other accounts at this address."
    btnMatchAddress.Visible = True
    End If

    End Sub


    I'm too novice to know how to fix, can you point me in the right direction?

    thanks

  4. #4
    Join Date
    May 2005
    Location
    Nevada, USA
    Posts
    2,888
    Provided Answers: 6
    It looks okay offhand. Can you post the db?
    Paul

  5. #5
    Join Date
    Jun 2010
    Posts
    186
    Unfortunatley, I cannot post from this system.......

    I have noticed an error code regarding the button.....I feel like I don't have a proper loop for the button visibility.......because I have 2 falses and only one true. It works, but I just feel like it is unclosed loop.

    Secondly, I feel like I need an Else since I took out the cancel - it doesn't seem to know what to do if there is not a match

    Here is all the VBA for this form -
    Option Compare Database

    Private Sub btnOKCLOSEADD_Exit(Cancel As Integer)

    End Sub


    Private Sub btnOKCLOSEADD_Click()
    On Error GoTo Err_btnOKCLOSEADD_Click


    DoCmd.Close

    Exit_btnOKCLOSEADD_Click:
    Exit Sub

    Err_btnOKCLOSEADD_Click:
    MsgBox Err.Description
    Resume Exit_btnOKCLOSEADD_Click

    End Sub
    Private Sub btnADDNEXTACCT_Click()
    On Error GoTo Err_btnADDNEXTACCT_Click


    DoCmd.GoToRecord , , acNewRec
    DoCmd.GoToControl ACCOUNT

    Exit_btnADDNEXTACCT_Click:
    Exit Sub

    Err_btnADDNEXTACCT_Click:
    MsgBox Err.Description
    Resume Exit_btnADDNEXTACCT_Click

    End Sub
    Private Sub Command24_Click()
    On Error GoTo Err_Command24_Click


    Screen.PreviousControl.SetFocus
    DoCmd.FindNext

    Exit_Command24_Click:
    Exit Sub

    Err_Command24_Click:
    MsgBox Err.Description
    Resume Exit_Command24_Click

    End Sub

    Private Sub ACCOUNT_BeforeUpdate(Cancel As Integer)
    If DCount("*", "ACCTTABLE21109", "ACCOUNT = '" & Me.ACCOUNT & "'") > 0 Then
    MsgBox Me.ACCOUNT & " already exists. DO NOT DUPLICATE. Return cold call sheet to salesman."
    Cancel = True
    Me.Undo
    End If

    End Sub

    Private Sub ACCOUNT_Enter()
    btnMATCHADDRESS.Visible = False
    End Sub

    Private Sub Exit_Click()
    On Error GoTo Err_Exit_Click


    DoCmd.Close

    Exit_Exit_Click:
    Exit Sub

    Err_Exit_Click:
    MsgBox Err.Description
    Resume Exit_Exit_Click

    End Sub
    Private Sub Save_Record_Click()
    On Error GoTo Err_Save_Record_Click


    DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

    Exit_Save_Record_Click:
    Exit Sub

    Err_Save_Record_Click:
    MsgBox Err.Description
    Resume Exit_Save_Record_Click

    End Sub
    Private Sub Add_New_Record_Click()
    On Error GoTo Err_Add_New_Record_Click


    DoCmd.GoToRecord , , acNewRec

    Exit_Add_New_Record_Click:
    Exit Sub

    Err_Add_New_Record_Click:
    MsgBox Err.Description
    Resume Exit_Add_New_Record_Click

    End Sub

    Private Sub ID_Click()
    DoCmd.Requery
    End Sub

    Private Sub ID_Exit(Cancel As Integer)
    DoCmd.OpenForm "ADDCHOOSER"

    End Sub

    Private Sub INTLZIP_AfterUpdate()
    INTLZIP = INTLZIP.Column(0)
    City = INTLZIP.Column(1)
    State = INTLZIP.Column(2)
    COUNTRY = INTLZIP.Column(3)

    End Sub

    Private Sub INTLZIP_DblClick(Cancel As Integer)
    On Error GoTo Err_INTLZIP_DblClick
    Dim lngINTLZIP As Long

    If IsNull(Me![INTLZIP]) Then
    Me![INTLZIP].Text = ""
    Else
    lngINTLZIP = Me![INTLZIP]
    Me![INTLZIP] = Null
    End If
    DoCmd.OpenForm "AddZip", , , , , acDialog, "GoToNew"
    Me![INTLZIP].Requery
    If lngINTLZIP <> 0 Then Me![INTLZIP] = lngINTLZIP

    Exit_INTLZIP_DblClick:
    Exit Sub

    Err_INTLZIP_DblClick:
    MsgBox Err.Description
    Resume Exit_INTLZIP_DblClick

    End Sub

    Private Sub INTLZIP_NotInList(NewData As String, Response As Integer)
    MsgBox "Double-click this field to add this International Zip Code to the list."
    Response = acDataErrContinue
    End Sub



    Private Sub STREET_ADDRESS_BeforeUpdate(Cancel As Integer)
    If DCount("*", "ACCTTABLE21109", "STREET_ADDRESS = '" & Me.Street_Address & "'") > 0 Then
    MsgBox Me.Street_Address & " already exists. Click Show Matches to see other accounts at this address."
    btnMATCHADDRESS.Visible = True
    End If

    End Sub

    Private Sub ZIP_AfterUpdate()
    Zip = Zip.Column(0)
    City = Zip.Column(1)
    State = Zip.Column(2)
    End Sub

    Private Sub ZIP_DblClick(Cancel As Integer)
    On Error GoTo Err_ZIP_DblClick
    Dim lngZIP As Long

    If IsNull(Me![Zip]) Then
    Me![Zip].Text = ""
    Else
    lngZIP = Me![Zip]
    Me![Zip] = Null
    End If
    DoCmd.OpenForm "AddZip", acFormAdd, , , , acDialog, "GotoNew"
    Me![Zip].Requery
    If lngZIP <> 0 Then Me![Zip] = lngZIP

    Exit_ZIP_DblClick:
    Exit Sub

    Err_ZIP_DblClick:
    MsgBox Err.Description
    Resume Exit_ZIP_DblClick

    End Sub

    Private Sub ZIP_Enter()
    btnMATCHADDRESS.Visible = False
    End Sub

    Private Sub ZIP_NotInList(NewData As String, Response As Integer)
    MsgBox "Double-click this field to add this Zip Code to the list."
    Response = acDataErrContinue

    End Sub

    Private Sub CONTACT_GotFocus()
    If IsNull(Zip) And IsNull(INTLZIP) Then
    MsgBox "Please enter a value " & _
    "into Zip Code or International Zip Code", vbOKOnly, _
    "WARNING! No Zip Code!"
    Zip.SetFocus
    Else
    Contact.SetFocus
    End If

    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •