Automatically Check Each Worksheet For Duplicate Entry
I didn't notice that in your first post.
Since you want to go to that cell, then there's no reason to use
application.countif to see if the value is there. That doesn't give you enough
info to actually go there.
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wsLoop As Worksheet
Dim FoundCell As Range
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
With wsLoop.Range("A2:A200")
Set FoundCell = .Cells.Find(what:=Target.Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
'not found
Else
MsgBox "That entry already exists he" & vbLf _
& FoundCell.Address(external:=True)
Application.EnableEvents = False
Target.ClearContents
Application.Goto FoundCell, scroll:=True 'or false??
Application.EnableEvents = True
Exit For
End If
End If
Next wsLoop
End Sub
Notice that the "exit for" as moved down a bit. It was a bug in the earlier
version. Enabling events would never take place, since the "exit for" line left
the loop.
Hasan wrote:
On Sep 18, 5:30 pm, Dave Peterson wrote:
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 AsWorksheet
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
ForEachwsLoop In ThisWorkbook.Worksheets
If wsLoop.Name = Sh.Name Then
'skip it
Else
If Application.CountIf(wsLoop.Range("A2:A200"), Target.Value) 0 _
Then
MsgBox "Thatentryalready 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 AsWorksheet
If Intersect(Target, Range("A2:A200")) Is Nothing Then Exit Sub
ForEachwsLoop In ThisWorkbook.Worksheets
If Not wsLoop.Name = "Sheet1" Then
If WorksheetFunction.CountIf(wsLoop.Range("A2:A200"),
Target) 0 Then
MsgBox "Thatentryalready 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- Hide quoted text -
- Show quoted text -
Hi Dave... thanks for the help.
I want the macro to select the value after clicking OK on message box.
Currently the code is showing me the sheet where the value exsists
after clicking OK message box but not the cell value
--
Dave Peterson
|