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
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