Add Name if it is not in the list

[Vincent88]

Hi Guy,
Active sheet Column A can select name from a dropdown list in worksheets("Data") Column L and can input name. I want to input a name and if it is not found in the dropdown list, then add this (new)name to the last empty cell in Column L.
My code does not work but shows no error. Appreciate any help to make it works.

Sub AddName2()


Dim srchRng As Range, oRng As Range
Dim M As Range, N As Range
Dim slastRow As Long, olastRow As Long
olastRow = Range("A3").End(xlDown).Row
Set oRng = Range("A3:A" & olastRow)
Set srchRng = Worksheets("Data").Range("L2:L" & slastRow)

On Error GoTo ErrHandler:

If Not Intersect(Target, Range("A3:A" & olastRow)) Is Nothing Then
   If Not IsNumeric(Target.Value) Then
      Application.EnableEvents = False
    
      
      For Each N In oRng
      Set M = srchRng.Find(Target.Value, , xlValues, xlWhole)
           If M = N Then
           Else
           Target.Value = Worksheets("Data").Range("L2:L" & slastRow + 1).Value
           End If
       Next N
      
ErrHandler:
Application.EnableEvents = True

End If
    
    Application.EnableEvents = True
    
End Sub

 

[maabadi]

if you want Normal Macro Try this:

Sub AdName2()
Dim srchRng As Range, oRng As Range
Dim M As Long, N As Range
Dim slastRow As Long, olastRow As Long
olastRow = Range("A3").End(xlDown).Row
slastRow = Worksheets("Data").Range("L2").End(xlDown).Row
Set oRng = Range("A3:A" & olastRow)
Set srchRng = Range("L2:L" & slastRow)
On Error Resume Next
    For Each N In oRng
        If Not IsNumeric(N.Value) Then
            M = srchRng.Find(N.Value).Row
                If M = 0 Then
                Worksheets("Data").Range("L" & slastRow + 1).Value = N.Value
                slastRow = slastRow + 1
                Else
                M = 0
                End If
        End If
    Next N

End Sub

and if Worksheet Change event. Right click on sheet name and paste this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim srchRng As Range, oRng As Range
Dim M As Long, N As Range
Dim slastRow As Long, olastRow As Long
olastRow = Range("A3").End(xlDown).Row
slastRow = Worksheets("Data").Range("L2").End(xlDown).Row
Set oRng = Range("A3:A" & olastRow)
Set srchRng = Range("L2:L" & slastRow)
Application.EnableEvents = False
On Error Resume Next
    If Not IsNumeric(Target.Value) Then
        M = srchRng.Find(Target.Value).Row
        If M = 0 Then Worksheets("Data").Range("L" & slastRow + 1).Value = Target.Value
    End If
Application.EnableEvents = True
End Sub

 

[Vincent88]

Hi maabadi,
The code addes all names in the column to the list. I only want the new name to copy. Or it can be the active cell's value which is new when the moment I input it, the code will find it is already existed or not.

 

[maabadi]

Then Use worksheet change event macro.
Right-click on Sheet name. Select view Code and Paste it at window appears.

 

[Vincent88]

Hi maabadi,
The worksheet change event mode adds old and new names to the list.

 

[Vincent88]

Hi maabadi,
The worksheet change event mode adds old and new names to the list.

Set srchRng = Range("L2:L" & slastRow) S/B Set srchRng = Worksheets("Data").Range("L2:L" & slastRow)

 

[maabadi]

I want to input a name and if it is not found in the dropdown list, then add this (new)name to the last empty cell in Column L.

The worksheet change event mode adds old and new names to the list.

You told you want to add new name after last row of old names. then macro added new Names after previous names at the Column L and don't Delete OLD Names

How about This:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim srchRng As Range, oRng As Range
Dim M As Long, N As Range
Dim slastRow As Long, olastRow As Long
olastRow = Range("A3").End(xlDown).Row
slastRow = Worksheets("Data").Range("L2").End(xlDown).Row
Set oRng = Range("A3:A" & olastRow)
Set srchRng = Worksheets("Data").Range("L2:L" & slastRow)
Application.EnableEvents = False
On Error Resume Next
    If Not IsNumeric(Target.Value) Then
        M = srchRng.Find(Target.Value).Row
        If M = 0 Then Worksheets("Data").Range("L" & slastRow + 1).Value = Target.Value
    End If
Application.EnableEvents = True
End Sub

 

[HaHoBe]

Hi Vincent88,

maybe have a look at Excel Drop Down List - Add New Items. Although I expect that there are other events behind the sheet where the code needs to be integrated.

Ciao,
Holger

 

[Vincent88]

Hi maabadi,
With few adjustments, these codes work. Thank you.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim srchRng As Range
Dim M As Long
Dim slastRow As Long, lastRow as Long
slastRow = Worksheets("Data").Range("L2").End(xlDown).Row
Set srchRng = Worksheets("Data").Range("L2:L" & slastRow)
lastRow = Range("A3").End(xlDown).Row

If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("A3:A" & lastRow)) Is Nothing Then
        If Not IsNumeric(Target.Value) Then
Application.EnableEvents = False
On Error Resume Next
    If Not IsNumeric(Target.Value) Then
        M = srchRng.Find(Target.Value).Row
        'M = srchRng.Find(Target.Value, , xlValues, xlWhole).Row
        'Debug.Print M
        'Debug.Print Target.Value
        If M = 0 Then Worksheets("Data").Range("L" & slastRow + 1).Value = Target.Value
    End If
Application.EnableEvents = True

End If

End sub



Sub addName24()

Dim srchRng As Range
Dim M As Long
Dim slastRow As Long

slastRow = Worksheets("Data").Range("L2").End(xlDown).Row
Set srchRng = Worksheets("Data").Range("L2:L" & slastRow)

Application.EnableEvents = False
On Error Resume Next
    If Not IsNumeric(ActiveCell.Value) Then
        M = srchRng.Find(ActiveCell.Value).Row
        'M = srchRng.Find(Target.Value, , xlValues, xlWhole).Row
        Debug.Print M
        Debug.Print ActiveCell.Value
        If M = 0 Then Worksheets("Data").Range("L" & slastRow + 1).Value = ActiveCell.Value
    End If
Application.EnableEvents = True

End Sub