how to prevent duplicate entry for this case by vba code ?

[charly1988]

hello
I want to prevent duplicate entry from userform, let me explain, for example I have a userform with three fields, the first one is NAME and is a textbox the second one is departement and it is a comboboxlist, third textbox for their age and a button "add to base" so I want to authorize for example in sheet

A | B | C
marcel | IT | 29
marcel | WAREHOUSE | 29
(A is column of names, B column of departement, C column of Age)

but no authorize

A | B | C
marcel | IT | 29
marcel | IT | 29

 

[mumps]

Assuming the following object names are being used:
Textbox1
Combobox1
TextBox2
CommandButton1

Place this macro in the CommandButton1 code module:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, desWS As Worksheet, val1 As String, val2 As String
    Set desWS = Sheets("Sheet1")
    val1 = TextBox1.Value & "|" & ComboBox1.Value & "|" & TextBox2.Value
    v = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    For i = LBound(v) To UBound(v)
        val2 = v(i, 1) & "|" & v(i, 2) & "|" & v(i, 3)
        If val2 = val1 Then
            MsgBox ("You have made a duplicate entry." & Chr(10) & "Please try again.")
            Unload Me
            Exit Sub
        End If
    Next i
    With desWS
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3).Value = Array(TextBox1.Value, ComboBox1.Value, TextBox2.Value)
    End With
    Unload Me
    Application.ScreenUpdating = True
End Sub

 

[charly1988]

Assuming the following object names are being used:
Textbox1
Combobox1
TextBox2
CommandButton1

Place this macro in the CommandButton1 code module:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, desWS As Worksheet, val1 As String, val2 As String
    Set desWS = Sheets("Sheet1")
    val1 = TextBox1.Value & "|" & ComboBox1.Value & "|" & TextBox2.Value
    v = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    For i = LBound(v) To UBound(v)
        val2 = v(i, 1) & "|" & v(i, 2) & "|" & v(i, 3)
        If val2 = val1 Then
            MsgBox ("You have made a duplicate entry." & Chr(10) & "Please try again.")
            Unload Me
            Exit Sub
        End If
    Next i
    With desWS
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3).Value = Array(TextBox1.Value, ComboBox1.Value, TextBox2.Value)
    End With
    Unload Me
    Application.ScreenUpdating = True
End Sub

Thank you so much works as i want. But i have a small issue it's not preventing the data if it finds out its duplicate.....

 

[dmt32]

another idea maybe

Sub CheckDuplicate(ByRef Box As Control)
     Dim IsDuplicate    As Boolean
     Dim Form           As Object
     Dim ws             As Worksheet
     
     Set ws = ThisWorkbook.Worksheets("Sheet1")
     
     Set Form = Box.Parent
     
     IsDuplicate = Application.CountIfs(ws.Range("A:A"), "=" & Form.txtName, _
                                        ws.Range("B:B"), "=" & Form.cmbDepartment, _
                                        ws.Range("C:C"), "=" & Form.txtAge) > 1
   '
   Form.CommandButton1.Enabled = Not IsDuplicate
   Box.BackColor = IIf(IsDuplicate, vbRed, vbWhite)
End Sub

Private Sub txtName_Change()
    CheckDuplicate txtName
End Sub
Private Sub cmbDepartment_Change()
    CheckDuplicate cmbDepartment
End Sub

Private Sub txtAge_Change()
    CheckDuplicate txtAge
End Sub

If duplicate found should disabled your commandbutton

Change sheet name & control names as required.

Dave

 

[mumps]

I tested the macro using some dummy data and it worked properly. Could you upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[charly1988]

another idea maybe

Sub CheckDuplicate(ByRef Box As Control)
     Dim IsDuplicate    As Boolean
     Dim Form           As Object
     Dim ws             As Worksheet
    
     Set ws = ThisWorkbook.Worksheets("Sheet1")
    
     Set Form = Box.Parent
    
     IsDuplicate = Application.CountIfs(ws.Range("A:A"), "=" & Form.txtName, _
                                        ws.Range("B:B"), "=" & Form.cmbDepartment, _
                                        ws.Range("C:C"), "=" & Form.txtAge) > 1
   '
   Form.CommandButton1.Enabled = Not IsDuplicate
   Box.BackColor = IIf(IsDuplicate, vbRed, vbWhite)
End Sub

Private Sub txtName_Change()
    CheckDuplicate txtName
End Sub
Private Sub cmbDepartment_Change()
    CheckDuplicate cmbDepartment
End Sub

Private Sub txtAge_Change()
    CheckDuplicate txtAge
End Sub

If duplicate found should disabled your commandbutton

Change sheet name & control names as required.

Dave

Nice idea. Great... haven't thought about something like that, but it's impressive. Thank you very much for the idea and coding. Helps me a lot

 

[charly1988]

I tested the macro using some dummy data and it worked properly. Could you upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

The problem is if i use it in a module and call it that problem occurs, and in brief, i have a named range call "ITEM_LIST" which contains 7 columns. But i have to check the duplicate entries from columns 2,3 and 4. With your code, can replace the ranges with Named Ranges..?

 

[dmt32]

Nice idea. Great... haven't thought about something like that, but it's impressive. Thank you very much for the idea and coding. Helps me a lot

welcome, just another idea to play with

If want to make all controls red when duplicate entry then try this updated version

This in standard module or userform code page

Option Base 1
Sub CheckDuplicate(ByVal Form As Object)
     Dim IsDuplicate    As Boolean
     Dim Ctrls          As Variant, ctrl As Variant
     Dim ws             As Worksheet
   
     Set ws = ThisWorkbook.Worksheets("Sheet1")
   
     Ctrls = Array(Form.txtName, Form.cmbDepartment, Form.txtAge)
   
     IsDuplicate = Application.CountIfs(ws.Range("A:A"), "=" & Ctrls(1), _
                                        ws.Range("B:B"), "=" & Ctrls(2), _
                                        ws.Range("C:C"), "=" & Ctrls(3)) > 1
   '
   Form.CommandButton1.Enabled = Not IsDuplicate
 
   For Each ctrl In Ctrls
        ctrl.BackColor = IIf(IsDuplicate, vbRed, vbWhite)
   Next ctrl
End Sub

NOTE Option Base 1 statement which MUST be at the Top of the code page or module code resides in.

Updated code in Userform code page

Private Sub txtName_Change()
    CheckDuplicate Me
End Sub
Private Sub cmbDepartment_Change()
    CheckDuplicate Me
End Sub

Private Sub txtAge_Change()
    CheckDuplicate Me
End Sub

Dave