Macro to prevent duplicate entries

[y3kesprit]

Hello all,

I am currently using this macro to prevent users from entering similar entries within a spreadsheet.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
' Vasant Nanavati 2002
On Error GoTo ErrorHandler
If Not Intersect(Target, Columns(1)) Is Nothing Then
If Not Range(Cells(1, 1), Cells(Intersect _
(Target, Columns(1)).Row - 1, 1)).Find _
(Target.Value, LookIn:=xlValues, LookAt:= _
xlWhole) Is Nothing Then
MsgBox "Part no. already exists!"
Application.EnableEvents = False
With Intersect(Target, Columns(1))
.ClearContents
.Select
End With
End If
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

However, the problem I am facing is that its effect is for the whole spreadsheet. How can I limit this macro to one column only (say column B)?

Thanks for the help!

 

[jeffreybrown]

It seems you could accomplish this much easier with conditional formatting IMO.

http://www.cpearson.com/excel/NoDupEntry.aspx

 

[Tom Urtis]

This does not affect the entire sheet as you say, it only deals with column A.

Change this
If Not Intersect(Target, Columns(1)) Is Nothing Then

to this
If Not Intersect(Target, Columns(2)) Is Nothing Then

though data validation would be a lot less hassle.

 

[y3kesprit]

This does not affect the entire sheet as you say, it only deals with column A.

Change this
If Not Intersect(Target, Columns(1)) Is Nothing Then

to this
If Not Intersect(Target, Columns(2)) Is Nothing Then

though data validation would be a lot less hassle.

Thanks for the prompt reply.

I would use data validation if I could. But right now I am dealing with drop down menus, so my data validation is, in that sense, used up.

Thank you anyway!

 

[Tom Urtis]

This code is more efficient if you have your heart set on VBA.

 Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Column <> 2 Or .Cells.Count > 1 Then Exit Sub
If WorksheetFunction.CountIf(Columns(.Column), .Value) > 1 Then
Application.DisplayAlerts = False
.ClearContents
Application.DisplayAlerts = True
MsgBox "Part no. already exists!"
End If
End With
End Sub

 

[y3kesprit]

This does not affect the entire sheet as you say, it only deals with column A.

Change this
If Not Intersect(Target, Columns(1)) Is Nothing Then

to this
If Not Intersect(Target, Columns(2)) Is Nothing Then

though data validation would be a lot less hassle.

Not sure why, but that edit doesn't seem to solve the problem

 

[Tom Urtis]

See my post immediately above your last one.

 

[y3kesprit]

See my post immediately above your last one.

That was amazing, Tom.

Thanks for your help.

 

[Peter Harms]

This code is more efficient if you have your heart set on VBA.

 Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Column <> 2 Or .Cells.Count > 1 Then Exit Sub
If WorksheetFunction.CountIf(Columns(.Column), .Value) > 1 Then
Application.DisplayAlerts = False
.ClearContents
Application.DisplayAlerts = True
MsgBox "Part no. already exists!"
End If
End With
End Sub

I was about to tear the little hair I have left completely out when I came across this code.
I have 'hijacked' it....hope that is ok with you?
Amazing...simple and efficient.
Thank you!!

 

[Tom Urtis]

As someone similarly follicly challenged, your comment is well-appreciated!