attach the current file again
attach the current file again
Hi
The file with three sheets and very little data is over 323kb so i have zipped it
Peter
Hi
The code I provided is not there in the workbook. I edited my original code. So you can copy that code and paste in the Workbook module. It is working fine here.
BTW, End Sub is missing in your workbook_open event code.
Cheers !
Excel Range to BBCode Table
Use Social Networking Tools If You Like the Answers !
Message to Cross Posters
@ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)
Hi
Thanks for that i must have deleted the en sub!
the pop up now works on every sheet, but i was after it searching all sheets so that if i was entering a reg in contract sheet but the reg had been archived
it would inform me that it was dulicated in that sheet so i could copy that data back into the live contract page
Peter
OK. Try this
Again in thisworkbook module.Code:Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim rFound As Excel.Range Dim rCount As Long Dim Shts As Variant Dim i As Long Shts = Array("USED CONTRACTS", "ARCHIVE", "CONTRACTS") Select Case UCase$(Sh.Name) Case "USED CONTRACTS", "ARCHIVE", "CONTRACTS" '<<<<< add more sheets (in upper case) If Target.Column = 2 Then For i = LBound(Shts) To UBound(Shts) rCount = rCount + Application.WorksheetFunction.CountIf(Worksheets(Shts(i)).UsedRange.Columns(2), Target.Value) If rCount > 1 Then Set rFound = Worksheets(Shts(i)).UsedRange.Columns(2).Find(What:=Target.Value, MatchCase:=False, Lookat:=xlWhole) If Not rFound Is Nothing Then If MsgBox("The registration Number " & Target.Value & _ " has been found in row " & rFound.Row & vbCrLf & vbCrLf & _ "Do you want to view this entry?", vbQuestion + vbYesNo, "Confirm") = vbYes Then '// You might want to delete the 'new' entry/entire line here '// otherwise the suplicate remains. '// Application.EnableEvents = False '// Target.Value = vbNullString '// Application.EnableEvents = True Application.Goto rFound, True 'rFound.Activate Exit For End If End If End If Next End If End Select End Sub
Cheers !
Excel Range to BBCode Table
Use Social Networking Tools If You Like the Answers !
Message to Cross Posters
@ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)
HI
Sorry to be a pain
It does not seem to work at all now?
I have nothing in (contracts,used contracts,archive)
row deletion code in (this workbook)
your new code in module 1
Is this correct?
Hi
If i put this in the workbook and not in module 1 it will work as before find duplications in the sheet i am in but not find a reg in archive
if i am in the contracts sheet
i have notice now that if there is a reg in the archive sheet and i type it in the contract sheet it finds its self on the contract sheet, so it is seeing the duplicated reg but not saying which sheet it is on and not taking you to that sheet.
Also when it locates a duplicate in the same sheet and you press ok to go to it .the sheet moves over one column so you cant see the customer name
Thanks for looking
Peter
Last edited by peter renton; 07-25-2013 at 06:11 PM. Reason: additional findings
It works fine here.
PFA.
Cheers !
Excel Range to BBCode Table
Use Social Networking Tools If You Like the Answers !
Message to Cross Posters
@ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)
Hi
I have tried your test file and it finds the regs on other sheets but it also finds itself on the sheet your on?
Cheers
Peter
Hi
Is this what you are after ?
Code:Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim rFound As Excel.Range Dim rCount As Long Dim Shts As Variant Dim i As Long Shts = Array("CONTRACTS", "USED CONTRACTS", "ARCHIVE") Select Case UCase$(Sh.Name) Case "CONTRACTS", "USED CONTRACTS", "ARCHIVE" '<<<<< add more sheets (in upper case) If Target.Column = 2 Then For i = LBound(Shts) To UBound(Shts) rCount = rCount + Application.WorksheetFunction.CountIf(Worksheets(Shts(i)).UsedRange.Columns(2), Target.Value) If rCount And rFound Is Nothing Then Set rFound = Worksheets(Shts(i)).UsedRange.Columns(2).Find(What:=Target.Value, MatchCase:=False, Lookat:=xlWhole) End If If rCount > 1 Then If MsgBox("The registration Number " & Target.Value & _ " has been found in row " & rFound.Row & vbLf & "on Sheet '" & rFound.Parent.Name & "'" & vbCrLf & vbCrLf & _ "Do you want to view this entry?", vbQuestion + vbYesNo, "Confirm") = vbYes Then '// You might want to delete the 'new' entry/entire line here '// otherwise the suplicate remains. '// Application.EnableEvents = False '// Target.Value = vbNullString '// Application.EnableEvents = True Application.Goto rFound 'rFound.Activate Exit For End If End If Next End If End Select End Sub
Last edited by Admin; 07-26-2013 at 10:11 AM.
Cheers !
Excel Range to BBCode Table
Use Social Networking Tools If You Like the Answers !
Message to Cross Posters
@ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)
Bookmarks