| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatically Check Each Worksheet For Duplicate Entry
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Automatically Check Each Worksheet For Duplicate Entry
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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Automatically Check Each Worksheet For Duplicate Entry
On Sep 22, 1:37*am, Dave Peterson wrote:
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 AsWorksheet * * 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 * * ForEachwsLoop 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 "Thatentryalready 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- Hide quoted text - - Show quoted text - Hi Dave, I have tried pasting your code in "Thisworkbook" but its not working. I am still able to reselect/reenter the same values from data validation dropdown |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Automatically Check Each Worksheet For Duplicate Entry
Add this to the top of the code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) msgbox "workbook_sheetchange fired" ... If you don't see the message box after you make a change, then make sure that macros are enabled for this workbook. (You may have to close the workbook and reopen it to see the enable macros prompt.) And make sure that events are still enabled. Open the VBE (alt-f11 is one way) hit ctrl-g (to see the immediate window) type this application.enableevents = true and hit enter Then back to excel to test. Hasan wrote: On Sep 22, 1:37 am, Dave Peterson wrote: 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 AsWorksheet 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 ForEachwsLoop 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 "Thatentryalready 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- Hide quoted text - - Show quoted text - Hi Dave, I have tried pasting your code in "Thisworkbook" but its not working. I am still able to reselect/reenter the same values from data validation dropdown -- Dave Peterson |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Finding duplicate cells within a worksheet automatically | Excel Worksheet Functions | |||
| Duplicate Entry | Excel Worksheet Functions | |||
| ... Can I set Spell Check to automatically check my spelling ... | Setting up and Configuration of Excel | |||
| Entry into check box dependent on other check box. | Excel Worksheet Functions | |||
| how can I check a worksheet for duplicate entries or numbers? | Excel Worksheet Functions | |||
![Hasan[_2_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Hybrid Mode
