Avoid Duplicate Names

**realniceguy5000** · 08-05-2010, 11:16 AM

Hi,

I'm having at least one issue with this script below. Maybe more...the script is suppose look in Range A3:A100 for the last name that was just entered. if it finds the same name it then needs to look in Range B3:B100 at the first name, if both match a name that is already there then the cells are cleared and the user is asked to try again.

What I found out so far is that cell that the data is entered on is always going to be in the list so it will always find a duplicate.

I need a way to see if the name is listed more than once.

Can someone advise?

Thank You, Mike

Sub DoubleCheck()
Stop

Dim A, B As String
Dim R, R2, AA, BB As Range
Dim Cell, Cell2 As Object

A = Range("A100").End(xlUp).Value: AA = Range("A100").End(xlUp).Address
B = Range("B100").End(xlUp).Value: BB = Range("B100").End(xlUp).Address

Set R = Range("A3:A100")
Set R2 = Range("B3:B100")

For Each Cell In R: Cell.Select ' REMOVE SELECT AFTER TEST
    If A = Cell.Value Then
        For Each Cell2 In R2: Cell2.Select 'REMOVE SELECT
            If B = Cell2.Value Then
            MsgBox (Cell2.Value & B)
            
                MsgBox ("That Name Already Exists !!! Please Try Again..."), vbCritical, "Name Exists"
              Range(AA, BB).ClearContents
                   Call LastName
            End If
        Next Cell2
    End If
Next Cell

End Sub

**EK1** · 08-05-2010, 01:16 PM

Maybe you could try posting a sample workbook so the concept is clearer. I'm confused as to where exactly you are entering the last and first names.

**Leith Ross** · 08-05-2010, 01:48 PM

Hello Mike,

It is easier and faster to use the Dictionary Object. The Dictionary allows you to randomly check if something already exists. Here is an example...

Sub Check_B()

  Dim Cell As Range
  Dim MyName As Variant
  Dim MyNames As Object
  Dim Rng As Range
  Dim RngEnd As Range
  
    Set Rng = Range("A3:B3")
    Set RngEnd = Cells(Rows.Count, Rng.Column).End(xlUp)
    If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Range(Rng, RngEnd)
    
    Set MyNames = CreateObject("Scripting.Dictionary")
    MyNames.CompareMode = vbTextCompare
    
      For Each Cell In Rng.Columns(1).Cells
        MyName = Cell.Text & " " & Cell.Offset(0, 1).Text
        If Not MyNames.Exists(MyName) Then
           MyNames.Add MyName, 0
        Else
          MsgBox "That Name Already Exists !!! Please Try Again...", vbCritical, "Name Exists"
          Cell.Resize(1, 2).ClearContents
          Call LastName
        End If
      Next Cell
     
    Set MyNames = Nothing
    
End Sub