Prevent duplicate entries in two columns

Tbitha 0
Viewed 46

I am currently trying to prevent users from entering duplicate entries between two columns (Column A and B). Values found in Column A should not be duplicated in Column B and my current code is not working

enter image description here

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim ws As Worksheet, EvalRange As Range
 
    Set EvalRange = Range("AA:BB")
    
    If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    
    If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
        MsgBox Target.Value & " already exists on this sheet."
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
    
End Sub
vba excel
1 Answers

Here's one approach using Match:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim v, col As Range
 
    If Target.Cells.Count > 1 Then Exit Sub  'run some checks...
    If Intersect(Target, Me.Range("A:B")) Is Nothing Then Exit Sub
    v = Target.Value
    If Len(v) = 0 Then Exit Sub
    
    Set col = Me.Columns(IIf(Target.Column = 1, 2, 1)) 'set column to check
    If Not IsError(Application.Match(v, col, 0)) Then
        MsgBox Target.Value & " already exists in column " & Left(col(1).Address(False, False), 1)
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
End Sub
useryB020
Related