Code to stop duplicate entries

[ipbr21054]

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.

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

 

[Logit]

.
Rather than have the user enter all of the information, then search for an existing customer name ... which is a misuse of resources ... search for the customer name first.
Then if the name is not located, they can proceed with entering the remainder of the information.

Here is a search function for your needs :

Option Explicit


Sub SrchCust()
On Error Resume Next
    Dim srchtrm As String
    Dim shtSrc As Worksheet
    Dim rng As Range
    Dim c As Range


    Set shtSrc = Sheets("POSTAGE")   'source sheet
    
    srchtrm = InputBox("Search For ...", "Enter Customer")
    
    'don't scan the entire column...
    Set rng = Application.Intersect(shtSrc.Range("B:B"), shtSrc.UsedRange)


    For Each c In rng.Cells
        If c.Value = srchtrm Then
            MsgBox "Customer already exists. ", vbInformation, "Customer Located"
            Exit Sub
        End If
    Next


End Sub

 

[NoSparks]

You could check right after entering the customer name into textbox2 and hitting enter.

Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim fndRng As Range

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

With Sheets("POSTAGE").Range("B:B")
    Set fndRng = .Find(What:=Me.TextBox2.Value, LookIn:=xlValues, LookAt:=xlWhole, _
                   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
End With
                   
If Not fndRng Is Nothing Then
    'name was found
    MsgBox Me.TextBox2.Value & " was found at  " & fndRng.Address(False, False)
    'set-up ready to type over
        With Me.TextBox2
                .SelStart = 0
                .SelLength = Len(.Text)
                .SetFocus
        End With
    'cancel moving out of textbox
    Cancel = True
End If
    
End Sub

 

[ipbr21054]

@NoSparks Morning,
I like this approach.
As apposed to having my staff hit enter can it be triggered like so.
Enter customers name in TextBox 2 then when they select TextBox3 this will then trigger the code to check & notifies them with the message.

I have noticed that when the msgbox pops up should you decide that you dont want to continue clicking on the command button 2 "close form" gets into a loop of clicking ok then cancel etc etc.
The userform closes down but still seeing the msgbox a couple of times.

Is there a work around should the user wish to leave the form without this loop,maybe another command button which could be used to kill the code & close the form etc, Just a thought ??


Still need to look at the other option above in a minute.

 

[My Aswer Is This]

This script will run when you exit Textbox2
Enter your search value into Textbox2

You will get a message box telling you what Ranges the value was found in
If it finds none it also gives you a message saying none found.
What you want done if none are found I'm not sure of.
Try this and if it will work we can work out other details later.

I don't like to add more and then find you do not like this.

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Modified  10/4/2018  7:13:56 AM  EDT
Dim r As Range
Application.ScreenUpdating = False
Dim ans As String
ans = TextBox2.Value
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "B").End(xlUp).Row
For Each r In Range("B1:B" & Lastrow)
If r.Value = ans Then ss = ss & r.Address & vbNewLine
Next
aa = Replace(ss, "$", "")
If aa <> "" Then MsgBox "I found  " & ans & "  in these ranges" & vbNewLine & aa
If aa = "" Then MsgBox ans & "  Was not found"

End Sub

 

[ipbr21054]

This script will run when you exit Textbox2
Enter your search value into Textbox2

You will get a message box telling you what Ranges the value was found in
If it finds none it also gives you a message saying none found.
What you want done if none are found I'm not sure of.
Try this and if it will work we can work out other details later.

I don't like to add more and then find you do not like this.

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Modified  10/4/2018  7:13:56 AM  EDT
Dim r As Range
Application.ScreenUpdating = False
Dim ans As String
ans = TextBox2.Value
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "B").End(xlUp).Row
For Each r In Range("B1:B" & Lastrow)
If r.Value = ans Then ss = ss & r.Address & vbNewLine
Next
aa = Replace(ss, "$", "")
If aa <> "" Then MsgBox "I found  " & ans & "  in these ranges" & vbNewLine & aa
If aa = "" Then MsgBox ans & "  Was not found"

End Sub

@MAIT
Please now use this code as i have changed the msg text etc then we both sign from same hymn book.

"1"
Code looks good now we need to continue with these things that i have noticed.
I type in a customers name that already exists.
I see the msgbox to advise "Customer TOM JONES exists in cell 999"
I click on ok but i am able to then complete the other text boxes etc.
Clicking on TRANSFER TO CANCEL stops the transfer to the sheet BUT clears all the text boxes so the user needs to type it all again.

"I think once the user has been told that the customer already exists the code should then focus on Textbox2 until the customer does not exist.
Then the user can continue to complete the other options"

So at this point of all the text boxes clearing if i click on CLOSE FORM i see the msgbox "Was not found and is ok to continue"
I then click on OK
I then click on CLOSE FORM.
The form closes BUT the customer that was a duplicated in this example "TOM JONES" continues to save.


"2"
With the form open & straight away you click ok CLOSE FORM you see the msgbox "customer was not found message"

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)'Modified  10/4/2018  7:13:56 AM  EDT
Dim r As Range
Application.ScreenUpdating = False
Dim ans As String
ans = TextBox2.Value
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "B").End(xlUp).Row
For Each r In Range("B8:B" & Lastrow)
If r.Value = ans Then ss = ss & r.Address & vbNewLine
Next
aa = Replace(ss, "$", "")
If aa <> "" Then MsgBox "Customer  " & ans & "  is duplicated in cell" & vbNewLine & aa, vbCritical, "DUPLICATE CUSTOMER CHECKER"


If aa = "" Then MsgBox ans & "  Was not found & is OK to continue", vbInformation, "DUPLICATE CUSTOMER CHECKER"




End Sub

 

[NoSparks]

Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim fndRng As Range

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

With Sheets("POSTAGE").Range("B:B")
    Set fndRng = .Find(What:=Me.TextBox2.Value, LookIn:=xlValues, LookAt:=xlWhole, _
                   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
End With
                   
If Not fndRng Is Nothing Then
    'name was found
    MsgBox Me.TextBox2.Value & " was found at  " & fndRng.Address(False, False)
    'clear the text box
    Me.TextBox2.Value = ""
    'cancel moving out of textbox
    Cancel = True
End If
    
End Sub

 

[ipbr21054]

@NoSparks

Trying out your code and works great.
Two things to ask please.
In the worksheet i am naming the customers of more than one entry like so.
TOM JONES
TOM JONES 2
TOM JONES 3
TOM JONES 4 etc etc

So on the userform i type in TextBox2 the customers name like TOM JONES
I see the message box advise me that TOM JONES exists in cell B123 etc
I have noticed that when i click on ok the TextBox2 is then cleared, at this point can we just set focus back on TextBox2 without clearing it as some customers surnames are quite long & would need to be entered all again.

Secondly to follow on from exists in cell B123 message each time i click ok i am told the location until they do not exists.
In this case it would be 4 times.

Can the code just look for the most recent and advise me the once ?

So when i type TOM JONES i am advised that TOM JONES 4 exists,i then know to type TOM JONES 5
Does this make sense / fall inline with what we are doing or does it seem going against.
I was thinking along the lines of 1 or 2 repeat customers & me clicking ok each time until i was able to type there name without the msgbox.


Thanks very much

 

[NoSparks]

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

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

 

[ipbr21054]

Can you explain what you wrote "don't know why " etc etc

If I have a list of 600 names and you order something from me then I don't know how many previous orders I've sent you.
So I wouldn't know if it was no sparks no sparks1 2 or 3 even.