Count Coloured cells by row

[bilby72]

i'm currently working on a spresd sheet (Excel 97) and i would like to count how many coloured cells (Black) there are by row
ie
cell(A1) will have a total amount of black coloured cells for row 1
cell (A2) will have a total amount of black coloured cells for row 2
ect for say 30 rows

cheers

 

[Zathras]

Not sure if you are counting based on background (interior) colour or foreground colour, but you can modify this as necessary:

Option Explicit
Const COUNT_COLOUR = 1

' 1 = Black

Const TEST_BACKGROUND = 1

' Change to 0 to count foreground

Sub CountColouredCells()

' Counts coloured cells in column B thru IV
' and puts value in column A
' for all active rows in the active sheet
' See help file for colour index values

Dim ARange As Range
Dim ARow As Range
Dim a As Range
Dim c As Range
Dim nCount As Integer
  Set ARange = Intersect(ActiveSheet.UsedRange, Range("A:A"))
  For Each a In ARange
    nCount = 0
    Set ARow = Intersect(ActiveSheet.UsedRange, _
                         Range(a.Offset(0, 1), a.Offset(0, 255)))
    For Each c In ARow
      If TEST_BACKGROUND Then
        If c.Interior.ColorIndex = COUNT_COLOUR Then nCount = nCount + 1
      Else
        If c.Font.ColorIndex = COUNT_COLOUR Then nCount = nCount + 1
      End If
    Next c
    a.Value = nCount
  Next a
  Set ARange = Nothing
  Set ARow = Nothing
End Sub

 

[xlbo]

Slightly easier I would've thought would be a UDF

Function CountBlack(rw as long)
ctr = 0
For i = 2 to 256
if cells(rw,i).interior.colorindex = 1 then
ctr = ctr + 1
else
end if
next i
CountBlack = ctr
end function

paste this into a standard module and in A1 enter
=CountBlack(row())
then copy down Rgds
Geoff
"Some cause happiness wherever they go; others whenever they go."
-Oscar Wilde

 

[Zathras]

Geoff: Good thought, but...

I tried that first, but the problem is that colour changes don't cause the function to be called to update the cell. It only gives the right result when the function is first pasted in (or you key <F2>+<Enter>).

My impression was that bilby72 wanted to be able to change colours and get an updated count.

Since he wants this on all 30 or so rows, he would be constantly copying and pasting. I thought a macro would be easier. All he has to do is assign a macro short-cut key and voila.

 

[xlbo]

Fair enough Zathras - good point - must be one of those weeks - that's twice I've forgotten that formatting changes don't trigger any event Rgds
Geoff
&quot;Some cause happiness wherever they go; others whenever they go.&quot;
-Oscar Wilde