×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Preventing Duplicates

Preventing Duplicates

Preventing Duplicates

(OP)
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

RE: Preventing Duplicates

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.

RE: Preventing Duplicates

(OP)
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.

RE: Preventing Duplicates

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,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Preventing Duplicates

(OP)
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.

RE: Preventing Duplicates

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...

=COUNTIF(B$1:B1,B2)=0

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Preventing Duplicates

(OP)
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.

RE: Preventing Duplicates

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"

combo

RE: Preventing Duplicates

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,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Preventing Duplicates

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,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Preventing Duplicates

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

       A        B      C      D
1   Customer   Item   desc   UoM
2      Joe     Jars    abc   Gal
3      Bob     Cans    xyz    lb
4      Joe     Jars    klm    kg
 
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... smile

Have fun.

---- Andy

There is a great need for a sarcasm font.

RE: Preventing Duplicates

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

RE: Preventing Duplicates

I would try something like this (code not tested)

CODE

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

 Dim bDupIsFound As Boolean
 Dim i As Integer

 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
     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
         .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 If
 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.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close