If duplicated name is found & next number in sequence

[ipbr21054]

Morning,

I am using the code supplied below.

When i open my worksheet i start to type a customers name in cell A6
When i leave the cell the code checks to see if this customer has purchased from me before by looking down column A & if so it then shows me the msgbox "A Duplicated Customers Name Was Found" etc etc

Customers name sequence are entered / saved like so,

TOM JONES
TOM JONES 001
TOM JONES 002
TOM JONES 003

So next time i i enter TOM JONES as opposed to me seeing the msgbox can we just have the code check column A then apply the next number in the sequence.

So i type in cell A6 TOM JONES, when i then leave the cell & the code checks column A for this name & if a match is found it would then apply in this case 004 so cell A6 then shows TOM JONES 004, if no match is found then leave the name typed in A6 as it is, this would be much easier for me.

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address = Range("A6").Address Then
      Dim lastrow As Long
      lastrow = Cells(Rows.Count, "A").End(xlUp).Row
      Dim SearchString As String
      Dim SearchRange As Range
      Dim r As Long
      Dim ans As Variant
      SearchString = Target.Value
      Set SearchRange = Range("A7:A" & lastrow).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
      If Not SearchRange Is Nothing Then
         r = SearchRange.Row
         ans = MsgBox("A Duplicated Customers Name Was Found." & vbNewLine & " " & vbNewLine & "Click Yes To View Their Details", vbYesNo + vbCritical, "DUPLICATED CUSTOMER NAME MESSAGE")
         If ans = vbYes Then Application.Goto Range("A" & r)
      End If
   End If
   Dim rng As Range, c As Range




   Set rng = Intersect(Target, Rows(6))




   If Not rng Is Nothing Then
      If rng.Cells.Count < Me.Columns.Count Then
         Application.EnableEvents = False
         For Each c In rng
            c.Value = UCase(c.Value)
         Next
         Application.EnableEvents = True
      End If
   End If
End Sub

Many thanks & have a nice day.

 

[Peter_SSs]

Would it be possible in your data to have a name like
ALLAN DAVIS
and another name like
ALLAN DAVIS JONES

 

[ipbr21054]

I was trying to get this sorted by using the below but get a variable not defind on the line in yellow

Private Sub Worksheet_Change(ByVal Target As Range)    Dim fndRng As Range
    Dim findString As String
    Dim i As Integer
    Dim wsDATABASE As Worksheet
    
    findString = Range("A6").Value
    If Len(findString) = 0 Then Exit Sub
    
    Set wsDATABASE = ThisWorkbook.Worksheets("DATABASE")
    i = 1
    Do
        Set fndRng = Nothing
        Set fndRng = wsDATABASE.Range("A:A").Find(What:=findString & Format(i, " 000"), _
                                                    LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
                                                    SearchDirection:=xlNext, MatchCase:=False)
        If Not fndRng Is Nothing Then
            i = i + 1
[COLOR=#ff0000]            Cancel = True[/COLOR]
        End If
    Loop Until fndRng Is Nothing
    
    Range("A6").Value = findString & Format(i, " 000")
    Cancel = False
    
End Sub

 

[Peter_SSs]

So, what is the answer to my question?

Would it be possible in your data to have a name like
ALLAN DAVIS
and another name like
ALLAN DAVIS JONES

 

[ipbr21054]

Would it be possible in your data to have a name like
ALLAN DAVIS
and another name like
ALLAN DAVIS JONES

Its possible but the search would be an exact match

 

[Peter_SSs]

Its possible ..

Thanks. Another question.
Is it possible that you could actually have more than 100 of the exact same name in your column of data?

 

[ipbr21054]

No,

I would assume maybe 20 maximum

 

[Peter_SSs]

I would assume maybe 20 maximum

OK, then give this a try in a copy of your workbook.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, c As Range, DataRange As Range
  
  Set Changed = Intersect(Target, Columns("A"))
  If Not Changed Is Nothing Then
    Set DataRange = Range("A2", Range("A" & Rows.Count).End(xlUp))
    Application.EnableEvents = False
    For Each c In Changed
      If Len(c.Value) > 0 Then
        If Evaluate("countif(" & DataRange.Address & ",""" & c.Value & """)") > 1 Then
          c.Value = c.Value & Format(Evaluate("countif(" & DataRange.Address & ",""" & c.Value & " 0*"")") + 1, " 000")
        End If
      End If
    Next c
    Application.EnableEvents = True
  End If
End Sub

 

[ipbr21054]

Thanks.
I will check it out once home in a few hours.

 

[ipbr21054]

Hi,
This works perfect & I like it very much.

Can i ask for some advice as im thinking of another possible number sequence,i know i asked in the first post but i overlooked something.

Assuming there is no TOM JONES in the list.
Currently i type TOM JONES and that is what you see when i leave the cell.
If i then type TOM JONES again i see TOM JONES 001


What would i need to alter for the default number for no current customer.
So i type TOM JONES & when i leave the cell i see the TOM JONES 001
If i then type TOM JONES AGAIN i would then see TOM JONES 002

Basically all first time customers will start with 001



Many thanks.