If duplicated name is found & next number in sequence

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,322
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.


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

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
44,611
Office Version
365
Platform
Windows
Would it be possible in your data to have a name like
ALLAN DAVIS
and another name like
ALLAN DAVIS JONES
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,322
I was trying to get this sorted by using the below but get a variable not defind on the line in yellow


Code:
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
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,322
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
44,611
Office Version
365
Platform
Windows
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

Well-known Member
Joined
Nov 16, 2010
Messages
3,322
No,

I would assume maybe 20 maximum
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
44,611
Office Version
365
Platform
Windows
I would assume maybe 20 maximum
OK, then give this a try in a copy of your workbook.

Rich (BB code):
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

Well-known Member
Joined
Nov 16, 2010
Messages
3,322
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,098,860
Messages
5,465,115
Members
406,414
Latest member
Discorz

This Week's Hot Topics

Top