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!

 

[xl3ruise]

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

Thanks! But it for my it only works for column B, how could you make this work for colomn C and D as well?

 

[xl3ruise]

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

And is it possible to make warning box, so if you duplicate a word you will get a warning: "This name is already excist, do you want to continue?" If you press yes it will duplicate and if you say no it will removed..?

 

[Tom Urtis]

This should do what you want.

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
Dim myChoice%
myChoice = MsgBox(.Value & " already exists." & vbCrLf & "Do you want to continue?", 36, "Duplicate entry alert")
If myChoice = 6 Then
MsgBox .Value & " will stay put.", 64, "You clicked Yes."
Exit Sub
Else
Application.DisplayAlerts = False
.ClearContents
Application.DisplayAlerts = True
MsgBox "Removed.", 64, "You clicked No."
End If
End If
End With
End Sub