code to prevent duplicate entries

[cart0250]

I have the below code that prevents a user from entering duplicate data within a column for each worksheet of the workbook. It is placed within the ThisWorkbook module. Columns A and B are excluded. I am wondering if there is a way to exclude certain worksheets. So if I have 5 sheets, is there a way to make the below code apply to only sheet numbers 1 and 3, for example.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If IsEmpty(Target.Value) Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Column < 3 Then Exit Sub
With Range(Cells(1, Target.Column).Address & ":" & Cells(Target.Row - 1, Target.Column).Address & "," & Cells(Target.Row + 1, Target.Column).Address & ":" & Cells(Rows.Count, Target.Column).Address)
Set c = .Find(Target.Value, , , xlWhole)
If Not c Is Nothing Then
MsgBox "Data already exists at range: " & c.Address(0, 0)
Target.Value = ""
End If
End With
End Sub

[Carim]

Hi,

Just add a test on the Sh object ...

HTH
Carim

[cart0250]

Any hints on how to do that?

[Carim]

If not (sh.Name = "Sheet1" or sh.Name = "Sheet3") then
...
End if

HTH
Carim

[cart0250]

thanks. that works great

[Carim]

Glad your problem is fixed

Thanks for the feedback

Carim