Prevent duplicate entries in two sheets

[YasserKhalil]

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]

UP

[shrivallabha]

You can use something on this line below until you get better solution. Place this Worksheet "1" Module

[vba]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[/vba]

At the moment it checks for one column only!

[YasserKhalil]

Mr. shrivallabha
Thank you for your attempt to help me
But my request is for all the Serial columns in both two sheets

[shrivallabha]

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 . Put this code in Sheet2 (1) Module.
[VBA]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
[/VBA]

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

[YasserKhalil]

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]

You will have to edit the code a bit as the sheet name will change. So replace that part with this code

[VBA]
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
[/VBA]
Only change: "1" is replaced with "2" and "2" replaced with "1"!

[YasserKhalil]

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

[VBA]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
[/VBA]

[austenr]

For that to work you would have to do some sort of loop to loop through each sheet.

[YasserKhalil]

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]

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]

You could put this in the ThisWorkbook code module.
[VBA]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
[/VBA]You might want to add a test whether Target.Cells(1,1) is a number.

[shrivallabha]

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

[vba]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
[/vba]

[shrivallabha]

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.

[vba]
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

[/vba]