Hi,
The code below goes into Thisworkbook code.
Select the range (any range) in which you want to prevent duplicates and name it "preventduplicates".
<pre>
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'--------------------------------------------------------
'this code prevents entering duplicates in
' userdefined range named: "preventduplicates"
'--------------------------------------------------------
Dim F, Isect, Rng2Check As Range
Dim count As Long
Dim name As name
'check if name "preventduplicates" exists
For Each name In ActiveWorkbook.Names
If UCase(name.name) = "PREVENTDUPLICATES" Then
Set Rng2Check = Range("preventduplicates")
Exit For
End If
Next
Set name = Nothing
If Rng2Check Is Nothing Then Exit Sub
'------------------------------------------------------
If IsError(Target) Then Exit Sub 'don't find errors
If Target.Cells(1) = "" Then Exit Sub 'allow remove contents
'------------------------------------------------------
Application.EnableEvents = False
'check if target intersects with range to check
Set Isect = Application.Intersect(Target, Rng2Check)
If Not Isect Is Nothing Then
If Target.Cells.count > 1 Then
'entering multiple values not allowed
Rng2Check.Select 'hilite checked range
MsgBox "Multiple values of " & "''" & Target.Cells(1).Value & "''" & " may not be entered in this range!", 16, "Duplicate values not allowed."
Application.Undo
Target.Select
Else
'check if targetvalue value already exists
With Rng2Check
Set F = .Find(Target.Cells(1), MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues)
FirstLocation = F.Address
Set F = .FindNext(F)
If Not F Is Nothing Then Location = F.Address
If Location <> FirstLocation Then
'targetvalue found more than once
Rng2Check.Select 'hilite checked range
MsgBox "The value " & "''" & Target.Value & "''" & " already exists in this range!" & vbCrLf & _
"Please click OK and enter a different value.", 16, "Duplicate values not allowed."
Application.Undo
Target.Select
End If
End With
End If
End If
exitsub:
Set Isect = Nothing
Set Rng2Check = Nothing
Application.EnableEvents = True
End Sub
</pre>