Preventing duplicate entry through Userform controls

[sanilmathews]

I have created a userform with a TextBox and ComboBox controls. The user key-in Date in TextBox and selects data from each of the ComboBox. Which are then saved to the worksheet named "Dashboard". Below piece of code does that perfectly.

Private Sub Add()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Dashboard")
lRow = ws.Cells(Row.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
    .Cells(lRow, 1).Value = Me.txtdate.Value
    .Cells(lRow, 2).Value = Me.Combobox1.Value
    .Cells(lRow, 3).Value = Me.Combobox2.Value
    .Cells(lRow, 4).Value = Me.Combobox3.Value
    .Cells(lRow, 5).Value = Me.Combobox4.Value
End With


Me.txtdate.Value
Me.Combobox1.Value = ""
Me.Combobox2.Value = ""
Me.Combobox3.Value = ""
Me.Combobox4.Value = ""
Unload Me
End Sub

As the entries are made in Dashboard worksheet, I would require a logic that would check for any duplicate entry on a particular date and prevents the user to add the entry to the worksheet. It is perfectly fine for an entry to repeat on a different date.

Not Permitted:
05/08/2018 | Test_1 | Test_2 | Test_3 | Test_4
05/08/2018 | Test_5 | Test_6 | Test_7 | Test_8
05/08/2018 | Test_1 | Test_2 | Test_3 | Test_4

Permitted:
05/08/2018 | Test_1 | Test_2 | Test_3 | Test_4
05/09/2018 | Test_1 | Test_2 | Test_3 | Test_4

Appreciate any help

Thanks!

 

[dmt32]

hi,
untested but see if following does what you want:

Place both codes in Userform code page;

Option Base 1
Private Sub Add_Click()
    Dim lRow As Long
    Dim arr As Variant
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("Dashboard")
    
'control values to array
    arr = Array(DateValue(Me.txtdate.Value), Me.ComboBox1.Value, _
                Me.ComboBox2.Value, Me.ComboBox3.Value, Me.ComboBox4.Value)
    
    If Not IsDuplicate(ws, arr) Then
'next empty row
        lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'add data to range
        ws.Cells(lRow, 1).Resize(, UBound(arr)).Value = arr
'close userform
        Unload Me
    Else
'duplicate entry
    Me.txtdate.SetFocus
    End If


End Sub

note Option Base 1 statement which MUST sit at very TOP of your Forms code page outside any procedure.

Function IsDuplicate(ByVal sh As Object, ByRef EntryValues As Variant) As Boolean
    Dim FoundCell As Range
    Dim arr() As Variant
    Dim FirstAddress As String
    Dim i As Integer
    
    Set FoundCell = sh.Columns(1).Find(DateValue(EntryValues(1)), LookIn:=xlValues, Lookat:=xlWhole)
    If Not FoundCell Is Nothing Then
     FirstAddress = FoundCell.Address
        Do
'1D array from range
        ReDim arr(1 To UBound(EntryValues))
        For i = 1 To UBound(arr)
            arr(i) = FoundCell.Offset(0, i - 1).Value
        Next
'compare arrays for match
        IsDuplicate = CBool(Join(arr, "") = Join(EntryValues, ""))
'inform user
        If IsDuplicate Then MsgBox "Duplicate Entry.", 16, "Entry Not Permitted": Exit Function
        Set FoundCell = sh.Columns(1).FindNext(FoundCell)
        Loop While FirstAddress <> FoundCell.Address
    Else
'no date match
    End If
End Function

Dave

 

[Jaafar Tribak]

How about this ;

Private Sub Add()
    Dim lRow As Long
    Dim ws As Worksheet
    Dim sSearchRangeAddr As String
    
    Set ws = Worksheets("Dashboard")
    lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    sSearchRangeAddr = Range(ws.Cells(1, 1), ws.Cells(Rows.Count, 1).End(xlUp).Address).Address
    If Not Evaluate("SUMPRODUCT(COUNTIF(" & sSearchRangeAddr & "," & sSearchRangeAddr & ")-1)>0") Then
        With ws
            .Cells(lRow, 1).Value = Me.txtdate.Value
            .Cells(lRow, 2).Value = Me.Combobox1.Value
            .Cells(lRow, 3).Value = Me.ComboBox2.Value
            .Cells(lRow, 4).Value = Me.Combobox3.Value
            .Cells(lRow, 5).Value = Me.Combobox4.Value
        End With
        Me.txtdate.Value
        Me.Combobox1.Value = ""
        Me.ComboBox2.Value = ""
        Me.Combobox3.Value = ""
        Me.Combobox4.Value = ""
        Unload Me
    Else
        MsgBox "Duplicate !"
    End If
End Sub

 

[sanilmathews]

Thanks dmt32 and Jaafar for your response.

I managed to set a key by concatenating the values received from all the controls in Column N, and then validating it for duplicates.

Dim key As String
Dim irow As Integer


key = txtDate.Value & Combobox1.Value & Combobox2.Value & Combobox3.Value & Combobox4.Value


Do Until ThisWorkbook.Sheets("Dashboard").Cells(irow, 1) = ""


If ThisWorkbook.Sheets("Dashboard").Cells(irow, 14) = key Then


MsgBox "Duplicate record"


Exit Sub


irow = irow + 1
Loop