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]

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

Just remove these 2 lines

If Len(c.Value) > 0 Then
  <del>If Evaluate("countif(" & DataRange.Address & ",""" & c.Value & """)") > 1 Then</del>
    c.Value = c.Value & Format(Evaluate("countif(" & DataRange.Address & ",""" & c.Value & " 0*"")") + 1, " 000")
  <del>End If</del>
End If

 

[ipbr21054]

Perfect many thanks.

I will start a new post for help with adding 001 to all the others

 

[ipbr21054]

Hi,
can i ask a question please about the code below.

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
          c.Value = c.Value & Format(Evaluate("countif(" & DataRange.Address & ",""" & c.Value & " 0*"")") + 1, " 000")
      End If
    Next c
    Application.EnableEvents = True
  End If
End Sub

If i go through my existing list i see i have the following

TOM JONES 001
TOM JONES 002
TOM JONES 003
TOM JONES 104

So i made a mistake with the last name.
I press F2 and change the 104 to 004
But when i leave the cell i then see TOM JONES 104 001

The question is for the future should i see a mistake the only way to have the it correct is move the code from the sheet, correct the name & then put the code back.

Understand me with this ?

Thanks

 

[Peter_SSs]

I press F2 and change the 104 to 004
But when i leave the cell i then see TOM JONES 104 001

The question is for the future should i see a mistake the only way to have the it correct is move the code from the sheet, correct the name & then put the code back.

Understand me with this ?

I think I understand what you are saying.
If you see a mistake with, say TOM JONES 104 then pres F2 and delete the whole " 104" at the end of the name & press Enter. The code should change the entry to TOM JONES 004

 

[ipbr21054]

Hi,
I did that and it worked fine as you advised, thanks.

One thing i have noticed a couple of times though is currently because of customers name sorted A-Z that in cell A6 at present is the name A BAKALI 001

Upon opening this worksheet at different times throughout the day i then see it as A BAKALI 001 001

 

[Peter_SSs]

Perhaps you have some other vba code in the workbook that is re-entering the A BAKALI 001 value in A6?

 

[ipbr21054]

ok thanks, i will keep an eye on it