Preventing Duplicates

[Thadius]

I am working with a user form that I need to check for duplicate, and prevent them from being entered.

Any help would be greatly appreciated.

Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPart As Long

Dim ws As Worksheet
Set ws = Worksheets("Items")

'find first empty row in database
''lRow = ws.Cells(Rows.Count, 1) _
'' .End(xlUp).Offset(1, 0).Row

'revised code to avoid problems with
'Excel lists and tables in newer versions
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'Verifying Customer
If Trim(Me.cboCustomer.Value) = "Select" Or Me.cboCustomer.Value = "" Then
Me.cboCustomer.SetFocus
MsgBox "Need a customer...duh!"
Exit Sub
End If

'Verifying Item
If Trim(Me.txtItem.Value) = "" Then
Me.txtItem.SetFocus
MsgBox "What good is a new item without an item number?"
Exit Sub
End If

'Verifying Unit of Measure
If Trim(Me.cboUoM.Value) = "Select" Or Me.cboUoM.Value = "" Then
Me.cboUoM.SetFocus
MsgBox "Kind of need to know how to count this new item..."
Exit Sub
End If

'Prevent duplicates


'copy the data to the database

With ws
.Cells(lRow, 1).Value = Me.cboCustomer.Value
.Cells(lRow, 2).Value = Me.txtItem.Value
.Cells(lRow, 3).Value = Me.txtdesc.Value
.Cells(lRow, 4).Value = Me.cboUoM.Value
End With

'clear the data
Me.cboCustomer.Value = "Select"
Me.txtItem.Value = ""
Me.txtdesc.Value = ""
Me.cboUoM.Value = "Select"
Me.cboCustomer.SetFocus

End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub UserForm_Click()

End Sub

 

[Andrzejek]

Could you define "duplicate"?
Can you have different Items for the same Customer?
Can you have the same Item with different Descriptions?
Can you have the same Item / Description with different Units of Measure?
Etc.


Have fun.

---- Andy

There is a great need for a sarcasm font.

 

[Thadius]

Trying to prevent the same item from being entered for the same customer more than once.

So if customer A had an item called "Jars". I would not want them to be able to enter the item "Jars" again as a new item.

Hope that helps.

Thank you for the reply.

 

[SkipVought]

You posted a previous thread on this very topic.

In that thread I suggested that you use the Data > Remove duplicates feature, but you never responded!

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Thadius]

Skip,

You suggested that I repost in this forum and I have taking your suggestion.

I am looking to prevent the duplicates from ever being entered. If I go to Data and remove duplicates it would have to be done after the fact and not want I am trying to accomplish.

 

[SkipVought]

In that event, you could use Data > Validation to prevent a duplicate in any column.

First convert your table to a Structured Table that will propagate table row characteristics to new rows: Insert > Tables > Table.

In the column(s) of interest 1) Select the data cells, 2) Data Data Tools > Validation — Settings TAB Allow: Custom and enter this formula assuming column B and headings in row 1...
[tt]
=COUNTIF(B$1:B1,B2)=0
[/tt]


Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Thadius]

Skip,

I had already tried that and it works if I try to enter the duplicate value directly into a cell within that column. However it does not work when the information is entered through the user module that is listed out in the code above. It still allows any duplicate to be entered.

 

[combo]

[tt]Dim rngMatchFound as Range
Set rngMatchFound = ws.Range("A:A").Find(Me.cboCustomer.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not rngMatchFound Is Nothing Then MsgBox "Duplicated value"[/tt]

combo

 

[SkipVought]

Why would your isolate the user from the sheet???

This is Excel, where the user is supposed to interact directly with the data on the sheet.

YOU want a database, like Access, where user is NOT supposed to interact directly with the data, but routinely interact with the data via a form.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[SkipVought]

Obviously I have a strong point of view on this sort of thing. The right tool for the right job, IMNSHO.

I apologize if I offended you.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Andrzejek]

I believe Thadius is trying to prevent the [red]RED[/red] info from being entered using the Form:

[pre]
A B C D
1 Customer Item desc UoM
2 Joe Jars abc Gal
3 Bob Cans xyz lb
4[red] Joe Jars klm kg[/red]
[/pre]
Same Item for the Customer, second Jars for Joe

combo, I think your sample of code checks only if Customer is already in Column A (unless that's just the 'proof of concept' of how to find stuff)

I agree with Skip, database would be the way to go. But if Excel is what you want...

Have fun.

---- Andy

There is a great need for a sarcasm font.

 

[combo]

You are right Andy, there shouldn't be duplicates in Customer + Item pair. In this case simple comparison in loop from 2 to lRow-1 will check it, if it has to be excel.

combo

 

[Andrzejek]

I would try something like [blue]this[/blue] (code not tested)

Private Sub cmdAdd_Click()
 Dim lRow As Long
 Dim lPart As Long
[blue]
 Dim bDupIsFound As Boolean
 Dim i As Integer
[/blue]
 Dim ws As Worksheet
 Set ws = Worksheets("Items")

 'find first empty row in database
 ''lRow = ws.Cells(Rows.Count, 1) _
 '' .End(xlUp).Offset(1, 0).Row

 'revised code to avoid problems with
 'Excel lists and tables in newer versions
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
 SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

 'Verifying Customer
 If Trim(Me.cboCustomer.Value) = "Select" Or Me.cboCustomer.Value = "" Then
     Me.cboCustomer.SetFocus
     MsgBox "Need a customer...duh!"
     Exit Sub
 End If

 'Verifying Item
 If Trim(Me.txtItem.Value) = "" Then
     Me.txtItem.SetFocus
     MsgBox "What good is a new item without an item number?"
     Exit Sub
 End If

 'Verifying Unit of Measure
 If Trim(Me.cboUoM.Value) = "Select" Or Me.cboUoM.Value = "" Then
     Me.cboUoM.SetFocus
     MsgBox "Kind of need to know how to count this new item..."
     Exit Sub
 End If

 'copy the data to the database

 With ws[blue]
     i = 2
     Do While .Cells(i, 1).Value <> ""
         If .Cells(i, 1).Value = Me.cboCustomer.Value And _
            .Cells(i, 2).Value = Me.txtItem.Value Then
            bDupIsFound = True
            MsgBox "Duplicate Entry"
            Exit Do
         End If
         i = i + 1
     Loop

     If Not bDupIsFound Then[/blue]
         .Cells(lRow, 1).Value = Me.cboCustomer.Value
         .Cells(lRow, 2).Value = Me.txtItem.Value
         .Cells(lRow, 3).Value = Me.txtdesc.Value
         .Cells(lRow, 4).Value = Me.cboUoM.Value[blue]
     End If[/blue]
 End With

 'clear the data
 Me.cboCustomer.Value = "Select"
 Me.txtItem.Value = ""
 Me.txtdesc.Value = ""
 Me.cboUoM.Value = "Select"
 Me.cboCustomer.SetFocus

 End Sub

 Private Sub cmdClose_Click()
 Unload Me
 End Sub

 Private Sub UserForm_Click()

 End Sub

Have fun.

---- Andy

There is a great need for a sarcasm font.