Need help

[Plukey]

I have code that High Lights Duplicates in a Workbook. Out of the 12 sheets only 7, I want to find dup's. All 7 are formatted as Table's and are identical. It also high lights the tab when one is found. It works perfect but I cant figure out how to exclude 4 of the sheets. Columns are A - T and it searches through B .

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 Dim ws As Worksheet, Dn As Range, Q As Variant
 With CreateObject("scripting.dictionary")
 .CompareMode = vbTextCompare
Application.ScreenUpdating = False
 For Each ws In Worksheets
    ws.Tab.ColorIndex = xlColorIndexNone '<<<
    ws.Range("B2:B106").Interior.ColorIndex = xlNone
        For Each Dn In ws.Range("B2:B106")
            If Dn.Value <> "" Then
                If Not .exists(Dn.Value) Then
                    .Add Dn.Value, Array(Dn, ws)
                Else
                    Q = .Item(Dn.Value)
                        Q(0).Interior.Color = vbRed
                        Dn.Interior.Color = vbRed
                        ws.Tab.Color = 225
                        Q(1).Tab.Color = 225
                    .Item(Dn.Value) = Q
                End If
            End If
        Next Dn
 Next ws
 
Application.ScreenUpdating = True '<<<
End With
End Sub

 

[MARK858]

@Plukey, you also need all instances of Sheet.Name changed to ws.Name.

The End If btw should be placed as below....

                Next Dn
           [COLOR="#FF0000"] End If[/COLOR]
        Next ws

 

[Plukey]

Oh!!! That's it... Ive been working on this Workbook for a week! Dang thanks guys!!!!

 

[Plukey]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 Dim ws As Worksheet, Dn As Range, Q As Variant
 With CreateObject("scripting.dictionary")
 .CompareMode = vbTextCompare
Application.ScreenUpdating = False
 For Each ws In Worksheets
If ws.Name <> "HOMEPAGE" And ws.Name <> "Other" And ws.Name <> "Closed PS" And ws.Name <> "Backlog to Research" And ws.Name <> "Pre-Scrap" Then
    ws.Tab.ColorIndex = xlColorIndexNone '<<<
    ws.Range("B2:B106").Interior.ColorIndex = xlNone
        For Each Dn In ws.Range("B2:B106")
            If Dn.Value <> "" Then
                If Not .exists(Dn.Value) Then
                    .Add Dn.Value, Array(Dn, ws)
                Else
                    Q = .Item(Dn.Value)
                        Q(0).Interior.Color = vbRed
                        Dn.Interior.Color = vbRed
                        ws.Tab.Color = 225
                        Q(1).Tab.Color = 225
                    .Item(Dn.Value) = Q
                    End If
                End If
            Next Dn
        End If
 Next ws
 
Application.ScreenUpdating = True '<<<
End With
End Sub