PDA

View Full Version : Prevent duplicate entries in two sheets



YasserKhalil
11-30-2010, 10:45 AM
Hi everybody
I have a workbook .. Sheet for main data and two other sheets which depend on the main sheet
I want to prevent duplicate entries for Serial field so that no serial is duplicated
Here's an attachment

YasserKhalil
11-30-2010, 12:17 PM
UP

shrivallabha
12-01-2010, 10:01 AM
You can use something on this line below until you get better solution. Place this Worksheet "1" Module

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastCheck As Long
Dim Serial As Integer
Serial = ActiveCell.Offset(-1, 0).Value
LastCheck = ActiveCell.Row - 2
With ActiveSheet.UsedRange
For i = 2 To LastCheck
If .Cells(i, 1).Value = Serial Then
MsgBox "Duplicate Entry Found!"
.Cells(LastCheck + 1, 1).Value = ""
End If
Next
End With
End Sub

At the moment it checks for one column only!

YasserKhalil
12-01-2010, 09:01 PM
Mr. shrivallabha (http://www.vbaexpress.com/forum/member.php?u=27076)
Thank you for your attempt to help me
But my request is for all the Serial columns in both two sheets

shrivallabha
12-02-2010, 10:51 AM
I thought you were looking for a clue than the whole solution! My apologies. All I meant to say was: there could be more elegant solution to this :dunno . Put this code in Sheet2 (1) Module.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
Dim Serial As Integer
'Not Necessary to execute for every column'
If ActiveCell.Column = 1 Or ActiveCell.Column = 3 Then

Serial = ActiveCell.Offset(-1, 0).Value
'Checking for the entry's existence in Main Sheet
If Sheets("Yasser").Range("A65536").End(xlUp).Row > _
Sheets("Yasser").Range("C65536").End(xlUp).Row Then
LastRow = Sheets("Yasser").Range("A65536").End(xlUp).Row
Else: LastRow = Sheets("Yasser").Range("C65536").End(xlUp).Row
End If

With Sheets("Yasser")
For i = 2 To LastRow
If .Cells(i, 1) = Serial Then
MsgBox "Serial Found!"
Exit For
End If
If i = LastRow And .Cells(i, 1).Value <> Serial Then
If ActiveCell.Offset(-1, 0).Value <> "" Then
MsgBox "Serial Not Found!"
End If
End If
Next i
End With
'Checking with current sheet
If Sheets("1").Range("A65536").End(xlUp).Row > _
Sheets("1").Range("C65536").End(xlUp).Row Then
LastRow = Sheets("1").Range("A65536").End(xlUp).Row
Else: LastRow = Sheets("1").Range("C65536").End(xlUp).Row
End If
With Sheets("1")
For i = 2 To LastRow
If (.Cells(i, 1).Value = Serial Or .Cells(i, 3).Value = Serial) And _
ActiveCell.Offset(-1, 0).Value <> "" Then
If i <> ActiveCell.Offset(-1, 0).Row Then
MsgBox "Duplicate Entry found @ Row : " & i
ActiveCell.Offset(-1, 0).Value = ""
End If
End If
Next i
End With
'Checking with the second sheet
If Sheets("2").Range("A65536").End(xlUp).Row > _
Sheets("2").Range("C65536").End(xlUp).Row Then
LastRow = Sheets("2").Range("A65536").End(xlUp).Row
Else: LastRow = Sheets("2").Range("C65536").End(xlUp).Row
End If
With Sheets("2")
For i = 2 To LastRow
If (.Cells(i, 1).Value = Serial Or .Cells(i, 3).Value = Serial) And _
ActiveCell.Offset(-1, 0).Value <> "" Then
If i <> ActiveCell.Offset(-1, 0).Row Then
MsgBox "Duplicate Entry found in Sheet 2 @ Row : " & i
ActiveCell.Offset(-1, 0).Value = ""
End If
End If
Next i
End With
End If
End Sub


You will have to edit the code to suit your requirements. Hth

YasserKhalil
12-03-2010, 04:08 AM
Thank you for your great help
This is for sheet1 .. What about sheet2, Can I copy your great code in Worksheet_Change as for sheet2 Or there will be a change?

shrivallabha
12-03-2010, 06:00 AM
You will have to edit the code a bit as the sheet name will change. So replace that part with this code


If Sheets("2").Range("A65536").End(xlUp).Row > _
Sheets("2").Range("C65536").End(xlUp).Row Then
LastRow = Sheets("2").Range("A65536").End(xlUp).Row
Else: LastRow = Sheets("2").Range("C65536").End(xlUp).Row
End If
With Sheets("2")
For i = 2 To LastRow
If (.Cells(i, 1).Value = Serial Or .Cells(i, 3).Value = Serial) And _
ActiveCell.Offset(-1, 0).Value <> "" Then
If i <> ActiveCell.Offset(-1, 0).Row Then
MsgBox "Duplicate Entry found @ Row : " & i
ActiveCell.Offset(-1, 0).Value = ""
End If
End If
Next i
End With
'Checking with the second sheet
If Sheets("1").Range("A65536").End(xlUp).Row > _
Sheets("1").Range("C65536").End(xlUp).Row Then
LastRow = Sheets("1").Range("A65536").End(xlUp).Row
Else: LastRow = Sheets("1").Range("C65536").End(xlUp).Row
End If
With Sheets("1")
For i = 2 To LastRow
If (.Cells(i, 1).Value = Serial Or .Cells(i, 3).Value = Serial) And _
ActiveCell.Offset(-1, 0).Value <> "" Then
If i <> ActiveCell.Offset(-1, 0).Row Then
MsgBox "Duplicate Entry found in Sheet 1 @ Row : " & i
ActiveCell.Offset(-1, 0).Value = ""
End If
End If
Next i

Only change: "1" is replaced with "2" and "2" replaced with "1"!

YasserKhalil
12-03-2010, 06:22 AM
You are a great man
Thanks a lot for your interest and help

Can the code be modified and put in Workbook_Sheetchange??
As in fact I have a lot of sheets that I have to prevent duplicates in specific range for each sheet....
I know it may be difficult but I'm sure you are able to do this task efficiently...

There is an idea may help us ... If we could name the ranges from different sheets and put these named ranges with a new name say "MyRange"
This may help us

I have a code that prevent duplicate entries in a sheet

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ray As Variant, Cl As Integer, C As Integer
If Not Intersect(Target, Range("Myrange")) Is Nothing Then
Ray = Split(Range("MyRange").Address, ",")
For Cl = 0 To UBound(Ray)
C = C + Application.CountIf(Range(Ray(Cl)), Target)
Next Cl
If C > 1 Then Target = ""
End If
End Sub

austenr
12-03-2010, 11:19 AM
For that to work you would have to do some sort of loop to loop through each sheet.

YasserKhalil
12-03-2010, 02:26 PM
For that to work you would have to do some sort of loop to loop through each sheet.
You mean it's difficult or what??
Can you help me?

Sean.DiSanti
12-03-2010, 02:28 PM
it's not difficult, just do a "For Each" loop. there are examples on the forum (one posted in the last couple of minutes in response to another thread) or in the help file

mikerickson
12-04-2010, 01:21 AM
You could put this in the ThisWorkbook code module.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = Sheet2.Name Or Sh.Name = Sheet3.Name Then
If IIf(Sh.Name = Sheet2.Name, 1, 0) < Application.CountIf(Sheet2.Cells, Target.Cells(1, 1).Value) Then
On Error GoTo ErrorExit
Application.EnableEvents = False
If MsgBox("Invalid Entry.", vbAbortRetryIgnore) <> vbIgnore Then
Application.Undo
End If
End If
End If
ErrorExit:
Application.EnableEvents = True
End Sub
You might want to add a test whether Target.Cells(1,1) is a number.

shrivallabha
12-07-2010, 10:01 AM
This is a code that will check:
1. For existence of serial in the main worksheet and
2. Repeat entry in all the other worksheets.

Unfortunately this will not work in ThisWorkbook module as the events do not suit this code. And even if they do, I don't know how to go @ it:dunno

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
Dim Serial As Integer
'Not Necessary to execute for every column'
If ActiveCell.Column = 1 Or ActiveCell.Column = 3 Then

Serial = ActiveCell.Offset(-1, 0).Value
'Checking for the entry's existence in Main Sheet
If Sheets("Yasser").Range("A65536").End(xlUp).Row > _
Sheets("Yasser").Range("C65536").End(xlUp).Row Then
LastRow = Sheets("Yasser").Range("A65536").End(xlUp).Row
Else: LastRow = Sheets("Yasser").Range("C65536").End(xlUp).Row
End If

With Sheets("Yasser")
For i = 2 To LastRow
If .Cells(i, 1) = Serial Then
MsgBox "Serial Found!"
Exit For
End If
If i = LastRow And .Cells(i, 1).Value <> Serial Then
If ActiveCell.Offset(-1, 0).Value <> "" Then
MsgBox "Serial Not Found!"
End If
End If
Next i
End With
'End of checking with the main sheet
For j = 2 To Sheets.Count
If Sheets(j).Range("A65536").End(xlUp).Row > _
Sheets(j).Range("C65536").End(xlUp).Row Then
LastRow = Sheets(j).Range("A65536").End(xlUp).Row
Else: LastRow = Sheets(j).Range("C65536").End(xlUp).Row
End If
With Sheets(j)
For i = 2 To LastRow
If (.Cells(i, 1).Value = Serial Or .Cells(i, 3).Value = Serial) And _
ActiveCell.Offset(-1, 0).Value <> "" Then
'Separate Conditions depending on the sheet i.e. Active Or Other
If j <> ActiveSheet.Index Then
MsgBox "Duplicate Entry found @ Row : " & i & " in " & Sheets(j).Name
ActiveCell.Offset(-1, 0).Value = ""
Exit Sub
End If

If j = ActiveSheet.Index = j And i <> ActiveCell.Offset(-1, 0).Row Then
MsgBox "Duplicate Entry found in this sheet @ Row : " & i
ActiveCell.Offset(-1, 0).Value = ""
Exit Sub
End If
End If
Next i
End With
Next j
End If
End Sub

shrivallabha
12-07-2010, 10:28 AM
I still am in the learning mode and I did not check enough. Place this code in ThisWorkbook module. However, I'd like to know the reason as to why the above code did not work. The specific part I have changed is marked in bold and red below.

Here I changed ActiveSheet.Index to Sh.Index. This I did out of intuition as Sh Object was declared by the application and ActiveSheet.Index was not working.


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LastRow As Long
Dim Serial As Integer
'Not Necessary to execute for every column'
If ActiveCell.Column = 1 Or ActiveCell.Column = 3 Then

Serial = ActiveCell.Offset(-1, 0).Value
'Checking for the entry's existence in Main Sheet
If Sheets("Yasser").Range("A65536").End(xlUp).Row > _
Sheets("Yasser").Range("C65536").End(xlUp).Row Then
LastRow = Sheets("Yasser").Range("A65536").End(xlUp).Row
Else: LastRow = Sheets("Yasser").Range("C65536").End(xlUp).Row
End If

With Sheets("Yasser")
For i = 2 To LastRow
If .Cells(i, 1) = Serial Then
MsgBox "Serial Found!"
Exit For
End If
If i = LastRow And .Cells(i, 1).Value <> Serial Then
If ActiveCell.Offset(-1, 0).Value <> "" Then
MsgBox "Serial Not Found!"
End If
End If
Next i
End With
'End of checking with the main sheet
For j = 2 To Sheets.Count
If Sheets(j).Range("A65536").End(xlUp).Row > _
Sheets(j).Range("C65536").End(xlUp).Row Then
LastRow = Sheets(j).Range("A65536").End(xlUp).Row
Else: LastRow = Sheets(j).Range("C65536").End(xlUp).Row
End If
With Sheets(j)
For i = 2 To LastRow
If (.Cells(i, 1).Value = Serial Or .Cells(i, 3).Value = Serial) And _
ActiveCell.Offset(-1, 0).Value <> "" Then
'Separate Conditions depending on the sheet i.e. Active Or Other
If j <> Sh.Index Then
MsgBox "Duplicate Entry found @ Row : " & i & " in " & Sheets(j).Name
ActiveCell.Offset(-1, 0).Value = ""
Exit Sub
MsgBox "Hi!"
End If
If j = Sh.Index And i <> ActiveCell.Offset(-1, 0).Row Then
MsgBox "Duplicate Entry found in this sheet @ Row : " & i
ActiveCell.Offset(-1, 0).Value = ""
Exit Sub
End If
End If
Next i
End With
Next j
End If
End Sub