Code to stop duplicate entries

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,699
Office Version
  1. 2007
Platform
  1. Windows
I have a userform where i enter data then when i press the Click To Transfer button this data is then entered on my worksheet.
I would like a code so upon pressing Click To Transfer it should check first that the customers name does not exist.
If the name does not exist then let the data be saved on the sheet.
Should there be a customers name of which is the same then i need to see a msgbox advising me of this.

Some info for you.

Worksheet is called POSTAGE
Customers name on worksheet will always be in column B
Range on worksheet is B8 & onwards.
The code will need to be able to search for letters & numbers

Below is the code for the Click To Transfer Button.

Code:
Private Sub CommandButton1_Click()Cancel = 0
If TextBox2.Text = "" Then
    Cancel = 1
    MsgBox "Customer not entered"
    TextBox2.SetFocus
ElseIf TextBox3.Text = "" Then
    Cancel = 1
    MsgBox "Item Not Entered"
    TextBox3.SetFocus
ElseIf TextBox4.Text = "" Then
    Cancel = 1
    MsgBox "Tracking Not Entered"
    TextBox4.SetFocus
ElseIf TextBox5.Text = "" Then
    Cancel = 1
    MsgBox "Username Not Selected"
    TextBox5.SetFocus
    
ElseIf OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False Then
    Cancel = 1
    MsgBox "Select Origin"
    
ElseIf OptionButton4.Value = False And OptionButton5.Value = False And OptionButton6.Value = False Then
    Cancel = 1
    MsgBox "Select An Ebay Account"
    
End If


If Cancel = 1 Then
    MsgBox "Not All Have Been Answered"
    Exit Sub
End If


Dim i As Long
Dim x As Long
Dim ctrl As Control
Dim lastrow As Long
lastrow = ThisWorkbook.Worksheets("POSTAGE").Cells(Rows.Count, 1).End(xlUp).Row
    


    
 With ThisWorkbook.Worksheets("POSTAGE")
    .Cells(lastrow + 1, 1).Value = TextBox1.Text: TextBox1.Value = ""
    .Cells(lastrow + 1, 2).Value = TextBox2.Text: TextBox2.Value = ""
    .Cells(lastrow + 1, 3).Value = TextBox3.Text: TextBox3.Value = ""
    .Cells(lastrow + 1, 5).Value = TextBox4.Text: TextBox4.Value = ""
    .Cells(lastrow + 1, 9).Value = TextBox5.Text: TextBox5.Value = ""
    .Cells(lastrow + 1, 4).Value = TextBox6.Text: TextBox6.Value = ""
    If OptionButton1.Value = True Then .Cells(lastrow + 1, 8).Value = "DR": OptionButton1.Value = False
    If OptionButton2.Value = True Then .Cells(lastrow + 1, 8).Value = "IVY": OptionButton2.Value = False
    If OptionButton3.Value = True Then .Cells(lastrow + 1, 8).Value = "N/A": OptionButton3.Value = False
    If OptionButton4.Value = True Then .Cells(lastrow + 1, 6).Value = "EBAY": OptionButton4.Value = False
    If OptionButton5.Value = True Then .Cells(lastrow + 1, 6).Value = "WEB SITE": OptionButton5.Value = False
    If OptionButton6.Value = True Then .Cells(lastrow + 1, 6).Value = "N/A": OptionButton6.Value = False
End With
TextBox2.SetFocus
TextBox1.Value = Now
TextBox1 = Format(TextBox1.Value, "dd/mm/yyyy")
End Sub
 
Last edited:
Don't know why you'd go through all that when you know what you want to enter in textbox2
See if this will do
Code:
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim fndRng As Range, findString As String, i As Integer

If Me.TextBox2.Value = "" Then Exit Sub
findString = Me.TextBox2.Value

With Sheets("POSTAGE").Range("B:B")
    Set fndRng = .Find(What:=findString, LookIn:=xlValues, LookAt:=xlWhole, _
                   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                   
    If Not fndRng Is Nothing Then
        'what was entered already exists - alter the name until not found
        For i = 2 To 20
            findString = Me.TextBox2.Value & " " & i
            Set fndRng = .Find(What:=findString, LookIn:=xlValues, LookAt:=xlWhole, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If fndRng Is Nothing Then Exit For
        Next i
        
        'message saying what name should be
        'MsgBox "The name to use is " & findString
        
        'enter that name into textbox 2
        With Me.TextBox2
            .Value = findString
            .SelStart = 0
            .SelLength = Len(.Text)
            .SetFocus
        End With
        
        'cancel moving out of text box
        Cancel = True
    End If
End With
    
End Sub


NoSparks.

This is a very clever / nice piece of work,i like this very much.

I have noticed this,
I have a customer with there first time purchase so i enter them like so, TOM JONES.
Next time they buy something i would enter that transaction as TOM JONES 2 then next time TOM JONES 3 etc etc
With this new code i enter TOM JONES & when i leave the TextBox i then see it change to TOM JONES 4,i complete the form & Transfer to the worksheet.
The code overwrites TOM JONES with TOM JONES 4

Now i either need to rethink how i add new first time customers to my worksheet or the code needs to transfer as TOM JONES 4 etc without overwriting the name which doesnt have a number at the end.

Do you see a reason why if my TextBox1 shows 04/10/2018 it saves to my worksheet as 10/04/2018 ?

Many thanks.
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
With regards to the date format issue i have formatted a cell in column A on the sheet as it was originally formated as date.
The transfer now works as it should in respect of 04/10/2018 to 04/10/2018 as opposed to 04/10/2018 to 10/04/2018

So it must have something to do with the format on the userform,ie text format then being expected to save on sheet as date format if that makes sense.

I am unable to just select all what is in column A and format to text because 04/10/2018 becomes something like 43855
So we need to alter the code on the userform to date format ??
 
Last edited:
Upvote 0
With this new code i enter TOM JONES & when i leave the TextBox i then see it change to TOM JONES 4,i complete the form & Transfer to the worksheet.
The code overwrites TOM JONES with TOM JONES 4
Is it not the code from post # 1 that you're using to write to the sheet ?
Shouldn't overwrite anything. Unless you're calculating lastrow incorrectly.
Try calculating lastrow inside the With ThisWorkbook.Worksheets("POSTAGE") to make sure you're on the right sheet for everything.
Other than that I don't know what you're doing.

I am unable to just select all what is in column A and format to text because 04/10/2018 becomes something like 43855
That's the kind of numbers Excel actually uses for dates, (in VBA it's the cells .Value2) which tells me the sheet has them as dates and you just need to apply formatting to the cells to display the dates the way you want. From the macro recorder .Cells(lastrow + 1, 1).NumberFormat = "mm/dd/yyyy;@"
 
Upvote 0
Morning,

This was my mistake and code working fine.
I formatted column A as text now and when i transfer data from form to sheet all is ok.
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top