Comparing multiple combo box (text) values in an Access VBA form to prevent duplicate entries with OR condition

ChunkedUp 0
Viewed 37

Putting together a query (with SQL statement) button that checks for duplicate combobox entries (within one submission) before they happen.

Trying to comprehend why this works:

ElseIf Me.pc_cbox1 = Me.pc_cbox2 Then
    MsgBox "Duplicate Program Code Error"

But this does not:

ElseIf (Me.pc_cbox1 Or Me.pc_cbox2 Or Me.pc_cbox3 Or Me.pc_cbox4 Or Me.pc_cbox5 Or Me.pc_cbox6 Or Me.pc_cbox7 Or Me.pc_cbox8) = 
(Me.pc_cbox1 Or Me.pc_cbox2 Or Me.pc_cbox3 Or Me.pc_cbox4 Or Me.pc_cbox5 Or Me.pc_cbox6 Or Me.pc_cbox7 Or Me.pc_cbox8) Then
    MsgBox "Duplicate Program Code Error"

Edit #1: Thought I was onto something with this loop:( ...

For intComboBox = 1 To 8
If Controls("pc_cbox" & intComboBox).ListIndex <> intComboBox Then
    If Controls("pc_cbox" & intComboBox).Value = Controls("pc_cbox" & intComboBox).Value Then
        MsgBox "Duplicate Program Code Error"
    End If
End If
Next intComboBox

Edit #2: @HansUp's suggestion works! I am going to dissect this loop for the next hour to better understand the dictionary concept. I am new to VBA (3rd week) and I know this code is mostly spaghetti at this point but I have been forced into learning as I go at work. Here is what I have put together as an add funding (percentages) per program without duplicates. 'Program Code' is part of the primary key for the SQL table and therefore will not accept duplicate entries. I wanted to prevent being able to submit duplicates on the form to nip this issue in the bud.

Private Sub fundAdd_Click()
Dim strSQL As String,  queryName As String, qdf1 As QueryDef, dct As Object, i As Long, strValue As String

queryName = "temp6"
If QueryExists(queryName) Then
DoCmd.DeleteObject acQuery, "temp6"
End If

Set dct = CreateObject("Scripting.Dictionary")
For i = 1 To 8
    strValue = Nz(Me.Controls("pc_cbox" & i).Value, "NULL")
    If dct.Exists(strValue) Then
        MsgBox "Duplicate Program Code Error"
        Exit For
    Else
        dct.Add strValue, vbNullString
    End If
Next


If Me.percentTotal <> 1 Then
    MsgBox "Total not equal to 100%"

Else
    strSQL = "INSERT INTO position_funding2(box_id, program_code, percent) VALUES ('" & fundboxid_cbox & "','" & pc_cbox1 & "','" & percent1 & "'), " & _
    " ('" & fundboxid_cbox & "','" & pc_cbox2 & "','" & percent2 & "'), ('" & fundboxid_cbox & "','" & pc_cbox3 & "','" & percent3 & "'), " & _
    " ('" & fundboxid_cbox & "','" & pc_cbox4 & "','" & percent4 & "'), ('" & fundboxid_cbox & "','" & pc_cbox5 & "','" & percent5 & "'), " & _
    " ('" & fundboxid_cbox & "','" & pc_cbox6 & "','" & percent6 & "'), ('" & fundboxid_cbox & "','" & pc_cbox7 & "','" & percent7 & "'), " & _
    " ('" & fundboxid_cbox & "','" & pc_cbox8 & "','" & percent8 & "');"
    
    MsgBox (strSQL)
    
    Set qdf1 = CurrentDb.CreateQueryDef("temp6")
    qdf1.Connect = "ODBC;Driver=MySQL ODBC 8.0 Unicode Driver;SERVER=sv03rm;UID=*****;PWD=*****;DATABASE=pobe;PORT=3306;DFLT_BIGINT_BIND_STR=1"
    qdf1.SQL = strSQL
    qdf1.ReturnsRecords = False
    DoCmd.OpenQuery "temp6"
    Me.List271.Requery
   
End If

Defaults

End Sub
controls ms-access forms vba
1 Answers

Use your combo box values as keys of a Dictionary. Before adding each of those combo values, use the Exists method to check whether that value was already stored in the Dictionary. If it does exist, the one you're about to add is a duplicate, so display your MsgBox notice.

You didn't provide any context about where and how you intend to do the comparison. So, for my version, I used a command button's click event.

Private Sub cmdCompare_Click()
    Dim dct As Object
    Dim i As Long
    Dim strValue As String

    Set dct = CreateObject("Scripting.Dictionary")
    For i = 1 To 8
        strValue = Nz(Me.Controls("pc_cbox" & i).Value, "NULL")
        If dct.Exists(strValue) Then
            MsgBox "Duplicate Program Code Error"
            Exit For
        Else
            dct.Add strValue, vbNullString
        End If
    Next
End Sub
HansUp0
Related