x
• Status: Solved
• Priority: Medium
• Security: Public
• Views: 1330

# Count number of grey shaded cells

Dear Experts:

I would like to count the number of cells that have a grey cell shading (RGB 223, 223, 223). They are all located in a row but are not contiguous.

I have attached a sample file for your convenience.

0
Andreas Hermle
• 5
• 5
• 5
• +2
3 Solutions

Commented:
Here's a UDF:
Function CountGreyCells(rngIn As Range) As Long
Dim rngCell As Range
Dim lngTemp As Long
For Each rngCell In rngIn
If rngCell.Interior.Color = RGB(223, 223, 223) Then lngTemp = lngTemp + 1
Next rngCell
CountGreyCells = lngTemp
End Function
0

Commented:
In K8 you would enter:
=countgreycells(B8:J8)
0

Senior Risk ManagerCommented:
Have a look here:

Chip Pearson's Color Functions

With the use of that module, you can count the number of cell's with a certain fill color.  The color will need to be in your palette.

I really can't say it any better than Chip has already done on his site, so I suggest going there and reading, but my guess is you will either use his CountColor function or a SUMPRODUCT such as

=SUMPRODUCT(--(COLORINDEXOFRANGE(B11:B17,FALSE,1)=COLORINDEXOFONECELL(H7,FALSE,1)))

where you will compare the range against the color of a certain cell.  There are a few ways to do what you want with his color functions.  It is really up to you how to do it.

Since you will need macro code, you will need to save the workbook as a macro-enabled workbook.

WC
0

Commented:
The colour index of that grey is 15 so you can use this code.

Sub sample()
Dim ws As Worksheet
Dim rng As Range, cl As Range
Dim nCount As Long

Set ws = Sheets("Tabelle1")
Set rng = ws.Range("A8:K8")

For Each cl In rng
If cl.Interior.ColorIndex = 15 Then
nCount = nCount + 1
End If
Next

Debug.Print nCount
End Sub

Sid
0

Commented:
Oh, and here's your file with UDF in place. Had to convert to xlsm of course.
0

Commented:
Forgot the volatility you will need - call it with:
=countgreycells(B8:J8)+NOW()*0
0

Commented:
Nice seeing you back, WC :)
0

Senior Risk ManagerCommented:
Thanks Patrick,

I have been busy the past year coding up automated reports from Excel to Word.  My analytics group was bought by another company last fall and we are just getting in our new building.  I will probably be spending the majority of my time this year coding in SAS, but I have some opportunity to do some things in Office related work.  I'm having to make the jump to Office 07/10, so I'm learning some new stuff too.  Already done some work with customizing the Office Ribbon for some Add-Ins of mine.

You probably won't see much of me around here, but I shouldn't be a ghost like the last 6 months or so.

Cheers,
WC
0

Dear all,

thank you very much for the overwhelming support, especially the one from rorya.

There is one question I am having RORYA:
What do mean by 'forgot the volatility you will need'?

WC: looks awesome, will test it and get back to you.

Will try every solution / approach and report back to you

Regards and thank you again.

Andreas
0

Commented:
You need to make sure the function gets recalculated when the worksheet does because changing cell colours does not cause a recalculation.
As a general observation, colour should be used to highlight data, not used as data.
0

Hi rorya:

just tried it out. Works like a charm. Great stuff. Thank you very much for your superb support.

Regards, Andreas
0

Hi Sid,

is it possible to re-write your code so that instead of being hardcoded, the current selection on the current worksheet gets worked on:

Set ws = Sheets("Tabelle1")
Set rng = ws.Range("A8:K8")

Help is much appreciated. Thank you very much in advance. Regards, Andreas
0

Senior Risk ManagerCommented:
No points for this.  Just adjusting Sid's code to your request.  Notice it is exactly like Rory's function.

WC
Function sample(rng as Range) as Long
Dim cl As Range
Dim nCount As Long

For Each cl In rng
If cl.Interior.ColorIndex = 15 Then nCount = nCount + 1
Next
sample = nCount
End Sub
0

Senior Risk ManagerCommented:
Whoops, forgot to change the End Sub to an End Function.

:)  It's early, need to wake up.
0

HI WarCrimes:

ok, thank you very much for your great support.

Regards, Andreas
0

Commented:
Thanks WarCrimes :)

Was away so couldn't do the needful in this thread :)

Sid
0

Senior Risk ManagerCommented:
No worries,

We are all here to help.  Glad I can step in now and then.

Cheers,
WC
0

Dear All,

again thank you very much for your overwhelming support. It is kind of hard to distribute the points equally.

This forum really deserves its name.

Regards, Andreas
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.