UserForm prevent duplicate entries

[inkserious]

I have a UserForm which enters data into a structured table. I need to prevent duplicate records from being entered based on three criteria: date, shift and time.

Ideally, the user would be prompted with a Msgbox alerting them that there is a duplicate record. They would have the option to click Yes and overwrite the duplicate record, or no and return to the UserForm.

Below is the code I am currently using. Thanks in advance for any help anyone can provide.

Private Sub cmdSubmit_Click()

Dim ws As Worksheet
Dim lrowCount As Long
Dim ctl As Control

Set ws = Worksheets("Sheet4")

lrowCount = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    ws.Cells(lrowCount, 1).Value = Me.cboDate.Value
    ws.Cells(lrowCount, 2).Value = Me.cboShift.Value
    ws.Cells(lrowCount, 3).Value = Me.cboTime.Value
    ws.Cells(lrowCount, 4).Value = Format(Me.txtDrop.Value, "#,##0")
    ws.Cells(lrowCount, 5).Value = Format(Me.txtWin.Value, "#,##0")
    ws.Cells(lrowCount, 6).Value = Format(Now(), "mm/dd/yy hh:mm")

    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
            ctl.Value = ""
        End If
    Next ctl

End Sub

 

[SkipVought]

hi,

I would FIRST query the table with the KEY ELEMENTS to test for its existance. In the event that it does NOT exist, then add the row.

faq68-5829

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[inkserious]

I know there is a more eloquent solution; however, this is what I came up with. It allows the user to overwrite an existing record, if found. I concatenated the three fields that need to be evaluated, and then used the countif and match function.

Regards,

-ep

Private Sub cmdSubmit_Click()
    [COLOR=green]'declare variables[/color]
Dim ws As Worksheet
Dim lrowCount As Long
Dim ctl As Control
Dim dRec As String
Dim answer As Integer
Dim dRow As Long

Set ws = Worksheets("Sheet4")
    
    [COLOR=green]'concatenate three fields to be tested and assign to variable dRec(duplicate record)[/color]
dRec = Format(Me.cboMonth.Value, "m/dd/yyyy") & Me.cboShift.Value _
    & Format(Me.cboTime.Value, "h:mm AM/PM")
    [COLOR=green]'assign last row to variable[/color]
lrowCount = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
   [COLOR=green] 'use countif function to test and see if there is a duplicate record[/color]
If Application.WorksheetFunction.CountIf(ws.Range("a2", ws.Cells(lrowCount, 4)), dRec) > 0 Then
       [COLOR=green] 'if a duplicate record is found, assign it's location to the variable dRow(duplicate row)[/color]
    dRow = Application.WorksheetFunction.Match(dRec, ws.Range("D:D"), False)
            [COLOR=green]'msgbox alerting user there was a duplicate record found[/color]
        answer = MsgBox("Duplicate Entry Found." & Chr(10) & "Do you want to overwrite?", _
            vbQuestion + vbYesNo, "Duplicate Found")
            
        If answer = vbYes Then
       [COLOR=green] 'if user answers yes, copy new values to existing record[/color]
    ws.Cells(dRow, 5).Value = Format(Me.txtDrop.Value, "#,##0")
    ws.Cells(dRow, 6).Value = Format(Me.txtWin.Value, "#,##0")
    ws.Cells(dRow, 7).Value = Format(Now(), "mm/dd/yy hh:mm")

Unload Me
   [COLOR=green] 'if the user selects no, stop the sub and allow the user to make changes[/color]
    Else
        If answer = vbNo Then
    Exit Sub
End If
End If

Else
    [COLOR=green] 'if there is not a duplicate found, copy the following values to the last row in the table[/color]
    ws.Cells(lrowCount, 1).Value = Me.cboMonth.Value
    ws.Cells(lrowCount, 2).Value = Me.cboShift.Value
    ws.Cells(lrowCount, 3).Value = Me.cboTime.Value
    ws.Cells(lrowCount, 4).Value = dRec
    ws.Cells(lrowCount, 5).Value = Format(Me.txtDrop.Value, "#,##0")
    ws.Cells(lrowCount, 6).Value = Format(Me.txtWin.Value, "#,##0")
    ws.Cells(lrowCount, 7).Value = Format(Now(), "mm/dd/yy hh:mm")

End If
Unload Me
End Sub