VBA code to loop in each row within a specific range, but the loop must start a new criteria in ever-CodePudding

I want to make a code that can detect a duplicate value in a row and highlight that value. I found the code and it works perfectly. But the problem is, the code loop within a range and it will highlight every value that have a duplicate. What I want is, the code/loop is only works in each row. Then in the next row, the loop start from the beginning again.

I make this, with the result below.

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

Result: Code results

But what I want is to be like this. Expected results: Expected code results

To do that, I have to make a code like this which is so annoying because I have about 50 rows to be executed. So this code will make me write a longer code that feel unnecessary.

The code:

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

Anyone can help me? I don't know how to do this with array. So if you guys have some answer, please help me!

*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)

CodePudding user response：

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