PDA

View Full Version : Solved: Alter exsisting code to find duplicate entries



BENSON
12-28-2007, 04:32 AM
I wish to alter the code below (Which Was Posted in This Form ) to check for duplicate entries being pasted in collums " A,B,C" .I have tried altertering it my self but keep getting it wrong


Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B:AA" '<== change to suit
Dim mpFormula As String

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Column Mod 5 = 2 Then
mpFormula = "=SUMPRODUCT((MOD(COLUMN(B2:AA200),5)=2)*" & _
"(B2:AA200<>"""")*(B2:AA200=" & .Address & "))"
If Me.Evaluate(mpFormula) > 1 Then
MsgBox "duplicate"
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


Thanks

Bob Phillips
12-28-2007, 04:59 AM
Duplicates per column or overall.

This is per column



Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A:C" '<== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Application.CountIf(Target.EntireColumn, Target.Value) > 1 Then
MsgBox "duplicate"
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

BENSON
12-28-2007, 05:03 AM
THANK YOU