Count conditionally formatted cells in each row until last row (VBA)-CodePudding

Maybe someone could help me with this one. I spent a lot of time, to find this working solution to count conditionally formatted cells:

    Sub CountColorCellsAQ3()
    'Variable declaration
    Dim rng As Range
    Dim lColorCounter As Long
    Dim rngCell As Range
    'Set the range of cells to count
    Set rng = Sheet2.Range("B2:Y2")
    'loop throught each cell in the range
    For Each rngCell In rng
        'Checking Red color
        If Cells(rngCell.Row, rngCell.Column).DisplayFormat.Interior.Color = RGB(198, 224, 180) Then
            lColorCounter = lColorCounter   1
        End If
    Next
    'Display the total number of red cells in cell listed below
    ActiveSheet.Range("AB2") = lColorCounter
    
    End Sub

It works only for one row and write result only in to one predefined cell. How should i update this code that it count formatted cells (range will be the same, but in different row) in every row till last row and put result near every row in dedicated Result column

PS.: every row is a different person, so i need to count colored cells for each person individualy

CodePudding user response：

Please, test the next code. It will count each row interior color having a specific value and return the count on Z:Z column

Sub CountColorCellsAQ3()
    Dim sh As Worksheet, rng As Range, lColorCounter As Long, lastRow As Long
    Dim lastCol As Long, i As Long, j As Long, checkColor As Long
    
    checkColor = RGB(198, 224, 180)
    Set sh = Sheet2
    lastRow = sh.Range("B" & sh.rows.count).End(xlUp).row
    
    'Set the range of cells to count
    Set rng = sh.Range("B2:Y" & lastRow)
    lastCol = rng.rows(1).cells.count 'last column
    'loop throught each cell in the range
    For i = 1 To lastRow
        'counting interior specific colored cells, for each row:        
        For j = 1 To lastCol
            If sh.cells(i, j).DisplayFormat.Interior.Color = checkColor Then
                lColorCounter = lColorCounter   1
            End If
        Next j
         sh.cells(i   1, "Z").Value = lColorCounter 'place the count in Z:Z column
                                                    'i   1 because the range starts from the second row ("B2")...
        lColorCounter = 0                           'reinitialize the variable
    Next i
End Sub