Prevent Duplicates from Excel UserForm

[inkserious]

Taking from the current VBA classes, I have created a very cool little UserForm to input data into a structured table. However, I've run into a problem in everyday use: the form has no code to check for a duplicate entry. There are three different fields than need to be verified to insure there is not a duplicate: date, shift and time. One solution I came up with was to add another column and concatenate the three fields together. Then I could use a countif statement in the code to see if a record already exits. The problem with that is I want to allow the user the option to overwrite the existing record. So, if a duplicate record is found, MsgBox("Duplicate Entry Found." & Chr(10) & "Do you want to overwrite?", vbQuestion + vbYesNo, "Duplicate Found") Here is my existing code:

[pre]

Private Sub cmdSubmit_Click()

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

Set ws = Worksheets("testRundown")

' Write data to worksheet

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 = Me.txtDrop.Value
ws.Cells(lrowCount, 5).Value = Me.txtWin.Value
ws.Cells(lrowCount, 6).Value = Format(Now(), "mm/dd/yy hh:mm")

' Clear the form
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl

Call cmdClose_Click

End Sub

[/pre]

 

[Guest]

Hi,


Use you're concatenated column & application.worksheetfunction.match to determine which row it is you need to overwrite, if you need to.


In short:

Concatenate date, shift and time as per your sheet.

Test if it exists alread, if so add your message box.

Then we have 3 options:

1. No duplicate - let lrowCount stick as above

2. Duplicate to be overwritten use match to determine lrowCount

3. Duplicate not to be overwritten - exit sub, with a message maybe.


then continue to populate the data.


Hope that helps,


M

 

[inkserious]

Thanks a million. It worked perfectly. I added two more variables. One to hold the string in the concatenated cell, and another to hold the location of the duplicate record, if found. Then I added a simple IF statement to check for the duplicate record. If one is found, and the user elects to overwrite the data, the record is updated. I've pasted the updated code below in the event it may be helpful to someone.


Regards.


-ep

[pre]

Private Sub cmdSubmit_Click()

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")

dRec = Format(Me.cboMonth.Value, "m/dd/yyyy") & Me.cboShift.Value _
& Format(Me.cboTime.Value, "h:mm AM/PM")

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

If Application.WorksheetFunction.CountIf(ws.Range("a2", ws.Cells(lrowCount, 4)), dRec) > 0 Then
dRow = Application.WorksheetFunction.Match(dRec, ws.Range("D:D"), False)
answer = MsgBox("Duplicate Entry Found." & Chr(10) & "Do you want to overwrite?", _
vbQuestion + vbYesNo, "Duplicate Found")

If answer = vbYes Then

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")

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

Else
If answer = vbNo Then
Exit Sub
End If
End If

Else

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")

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

[/pre]