View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default 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