Loop in each row within a specific range, but start a new criteria in every next row

Question

I want to detect a duplicate value in a row and highlight that value.

I found code and it works. But the problem is, the code loops within a range and it will highlight every value that has a duplicate.

What I want is, the code/loop only works in each row. Then in the next row, the loop starts from the beginning again.

Sub DetectDuplicate()
    Dim rng As Range, row As Range, cell As Range

    Set rng = Range("D6:AV15").SpecialCells(xlCellTypeVisible)
    
    For Each row In rng.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row
End Sub

Code results:

Expected results:

To do that, I have to make code like this because I have about 50 rows to be executed. This code will make me write a longer code that feels unnecessary.

Sub DetectDuplicateMain()
    Dim rng As Range, row As Range, cell As Range
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range
    Dim rng6 As Range, rng7 As Range, rng8 As Range, rng9 As Range, rng10 As Range
    Dim rng11 As Range, rng12 As Range, rng13 As Range, rng14 As Range, rng15 As Range
    Dim rng16 As Range, rng17 As Range, rng18 As Range, rng19 As Range, rng20 As Range

    Set rng1 = Range("D6:AV6").SpecialCells(xlCellTypeVisible)
    Set rng2 = Range("D7:AV7").SpecialCells(xlCellTypeVisible)
    Set rng3 = Range("D8:AV8").SpecialCells(xlCellTypeVisible)
    Set rng4 = Range("D9:AV9").SpecialCells(xlCellTypeVisible)
    Set rng5 = Range("D10:AV10").SpecialCells(xlCellTypeVisible)
    Set rng6 = Range("D11:AV11").SpecialCells(xlCellTypeVisible)
    Set rng7 = Range("D12:AV12").SpecialCells(xlCellTypeVisible)
    Set rng8 = Range("D13:AV13").SpecialCells(xlCellTypeVisible)
    Set rng9 = Range("D14:AV14").SpecialCells(xlCellTypeVisible)
    Set rng10 = Range("D15:AV15").SpecialCells(xlCellTypeVisible)
    
    For Each row In rng1.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng1(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row
    
    For Each row In rng2.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng2(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng3.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng3(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng4.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng4(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng5.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng5(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng6.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng6(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng7.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng7(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng8.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng8(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng9.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng9(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng10.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng10(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row
End Sub

I don't know how to do this with array.

*Note: I have to do twice For each, first in a row and second in a cell. Because 1 For each can't detect the cell.Value (Method 'Range' of object '_Global' failed)

Answer 1

Shorter using a loop to go over each row in the full range:

Sub DetectDuplicateMain()
    Dim row As Range, cell As Range, ws As Worksheet
    
    Set ws = ActiveSheet 'or whatever
    
    For Each row In ws.Range("D6:AV15").Rows
        For Each cell In row.Cells
            If Len(Trim(cell.Value)) > 0 Then
                If WorksheetFunction.CountIf(ws.Range(row.Cells(1), cell), cell.Value) > 1 Then
                    cell.Interior.Color = vbRed
                Else
                    cell.Interior.ColorIndex = xlNone
                End If
            End If
        Next cell
    Next row
End Sub