Highlighting duplicates across rages of multiple sheets

[max8719]

Hi Guys,

I have a challenge which I am struggling with. I need to highlight duplicates in rages across multiple sheets in a workbook.

There are 26 ranges which contain text values and the ranges are the same from sheets 1 to 10.

Ranges are:

D5:R5
D13:R13
D21:R21
D29:R29
D37:R37
D45:R45
D53:R53
D61:R61
D69:R69
D77:R77
D85:R85
D93:R93
D101:R101
D109:R109
D117:R117
D125:R125
D133:R133
D141:R141
D149:R149
D157:R157
D165:R165
D173:R173
D181:R181
D189:R189
D197:R197
D205:R205

Thanks in advance for your replies.

 

[Takae]

Please try both of codes.

Sub max1()
Dim cnt As Long, i As Long, j As Long, count As Long
Dim ws As Worksheet, sh As Worksheet
For Each sh In Worksheets
    For i = 5 To 205 Step 8
        For j = 4 To 18
            For Each ws In Worksheets
                cnt = WorksheetFunction.CountIf(ws.Range(ws.Cells(i, 4), ws.Cells(i, 18)), sh.Cells(i, j))
                count = count + cnt
                If count >= 2 Then
                    sh.Cells(i, j).Interior.ColorIndex = 3
                    Exit For
                End If
            Next
            count = 0
        Next
    Next
Next
MsgBox "Done"
End Sub

Sub max2()
Dim cnt As Long, i As Long, j As Long
Dim ws As Worksheet


For Each ws In Worksheets
    For i = 5 To 205 Step 8
        For j = 4 To 18
            cnt = WorksheetFunction.CountIf(ws.Range(ws.Cells(i, 4), ws.Cells(i, 18)), ws.Cells(i, j))
            If cnt >= 2 Then
                ws.Cells(i, j).Interior.ColorIndex = 3
            End If
        Next
    Next
Next
MsgBox "Done"
End Sub

 

[max8719]

I have tried both the second would work fine but I have tried to put a duplicate value in player 10 D197 and player 1 R5 and they don't highlight. Can I send you my workbook as I can't find how to attach the document function on here.

Thanks again

 

[max8719]

The whole range would be players 1 - 10 company names(the references listed previously)

 

[max8719]

sheet names are player 1, player 2 etc