Count Colored Cells by Row

[bdd12]

I have been using the below macro to count all colored cells in a variable range. There has been a new request though to count all colored cells by row, so instead of just one cell showing an output of the count for a range, there needs to be an output in column AE starting in row 5 and going down to the end of the range that counts the blue cells in that particular row. Is there a good way to adjust this macro to do that, or if not is there another that will do this job? I have also uploaded an image of the file I am using. The amount of rows and columns that contain blue highlighted cells can change so a macro that isn't specifically for the rows from F5:AD27, but that can adjust to smaller or larger ranges would be best

Sub CountColorCells()
'Variable declaration
Dim rng As RANGE
Dim lColorCounter As Long
Dim rngCell As RANGE
'Set the range
Set rng = Selection
'loop throught each cell in the range
For Each rngCell In rng
'Checking color
If Cells(rngCell.Row, rngCell.Column).DisplayFormat.Interior.COLOR = RGB(141, 180, 226) Then
lColorCounter = lColorCounter + 1
End If
Next
'Display the value in cell A1
Sheet1.RANGE("A1") = lColorCounter
End Sub

 

[Jeffrey Mahoney]

This puts the results of each rows color count in column AE. You can change that if you want.

In the future, can you please put your VBA code in between the CODE and /CODE

Sub CountColorCells()
  'Variable declaration
  Dim rng As Range
  Dim lColorCounter As Long
  Dim rngCell As Range
  Dim Cel As Range
  
  'Set the range
  Set rng = Selection
  'loop throught each cell in the range
  For Each rngCell In rng
    'Checking color
    lColorCounter = 0
    For Each Cel In Intersect(rngCell.EntireRow, Range("F:AD"))
      If Cel.DisplayFormat.Interior.Color = RGB(141, 180, 226) Then
        lColorCounter = lColorCounter + 1
      End If
    Next Cel
    Intersect(rngCell.EntireRow, Range("AE:AE")).Value = lColorCounter
    
  Next rngCell
  'Display the value in cell A1
  
End Sub