Automatically Check Each Worksheet For Duplicate Entry
Make sure you put the code in the ThisWorkbook module:
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wsLoop As Worksheet
If Intersect(Target, Sh.Range("A2:A200")) Is Nothing Then
Exit Sub
End If
If Target.Cells.Count 1 Then
Exit Sub 'single cell at a time
End If
For Each wsLoop In ThisWorkbook.Worksheets
If wsLoop.Name = Sh.Name Then
'skip it
Else
If Application.CountIf(wsLoop.Range("A2:A200"), Target.Value) 0 _
Then
MsgBox "That entry already exists in the " _
& wsLoop.Name & " sheet"
Application.EnableEvents = False
Target.ClearContents
wsLoop.Select
Exit For 'stop looking for more
Application.EnableEvents = True
End If
End If
Next wsLoop
End Sub
Hasan wrote:
hi
got a situation wherby in column A, there is a list of values for the
user to select using data validation list,
need to prevent the user from selecting 2 similar data in any of the
cells in column A of entire workbook
a error message has to appear to warn the user if such a situation
arises and then point to that cell value in a workbook
any idea how to do it?
Not sure the code i am using below is right...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim wsLoop As Worksheet
If Intersect(Target, Range("A2:A200")) Is Nothing Then Exit Sub
For Each wsLoop In ThisWorkbook.Worksheets
If Not wsLoop.Name = "Sheet1" Then
If WorksheetFunction.CountIf(wsLoop.Range("A2:A200"),
Target) 0 Then
MsgBox "That entry already exists in the " +
wsLoop.Name + " sheet"
Application.EnableEvents = 0
Target.ClearContents
wsLoop.Select
Application.EnableEvents = 1
End If
End If
Next wsLoop
End Sub
- Thanks
--
Dave Peterson
|