VBA to count the total number of red cells (ColorIndex = 3)

[Karthik Thandapani]

Hi,

Presently I have a snippet that will find cells which are highlighted in red and report in a cell. What I would like to receive help is; to count the total number of red cells and put that count in cell G3.

ColorIndex = 3

Please see the attached file.

Thanks,
Karthik

Sub ValiCheck_BG()

Application.ScreenUpdating = False


Worksheets("Sheet1").Activate

    Dim i As Long, r As Range, coltoSearch As String

    coltoSearch = "A"

    For i = 1 To Range(coltoSearch & Rows.Count).End(xlUp).Row
        Set r = Range(coltoSearch & i)
        If r.Interior.ColorIndex = 3 Then
       
             
Range("G2").Value = "Found"

End If
     
  Next i
 
End Sub

 

[Sathish KV]

Hi,

You can use a UDF as below

Once pasting the below code use the formula "=withcolor(A5,A2:A25,false)" in cell G3

Note: Replacing 'false' with 'True' in the above formula will give you the sum

Function withcolor(nclr As Range, nrng As Range, Optional SUM As Boolean)
 
Dim cll As Range
Dim clr As Long
Dim rlt
clr = nclr.Interior.ColorIndex
If SUM = True Then
For Each cll In nrng
If cll.Interior.ColorIndex = clr Then
rlt = WorksheetFunction.SUM(cll, rlt)
End If
Next cll
Else
For Each cll In nrng
If cll.Interior.ColorIndex = clr Then
rlt = 1 + rlt
End If
Next cll
End If
withcolor = rlt
 
End Function

 

[Bhawani]

Hi,
please try below code

Sub count_by_background_color()
Dim my_range As Range, i As Integer, j As Long
Set my_range = Sheet1.Columns("A")
Application.ScreenUpdating = False
i = 0
MsgBox Rows.Count
    For j = 1 To Rows.Count
        If Cells(j, 1).Interior.ColorIndex = 3 Then
        i = i + 1
        End If
    Next j
Sheet1.Range("G3").Value = i
    If i > 0 Then
        MsgBox "Found"
    End If
Application.ScreenUpdating = True
End Sub

PFA...
and would advice you to give range instead of looping through whole column. it takes much more time in looping in entire columns.