Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
Solved

# Count by Color using VBA

Posted on 2014-02-15
Medium Priority
384 Views
Dear Expert:

Entering the following formula into the formula bar, the number of  cells in Column E that contain the color in E2 are counted

countbycolor(E2,E1:E15)

The user-defined worksheet function works fine but I would like to get the whole thing automated, i.e. ...

A macro is  ...
... to  write this formula into B7 of the worksheet named 'Results' of the active workbook
... and the counting of the shaded cells is to be effected in Column E of a sheet named 'Evaluation' and where E5 is the cell reference that contains the background color (to be counted).
... The range of cells can be any number, e.g. E1:465 or E1:3244, i.e the range is variable

It would be great if somebody could help me with that. Help is much appreciated. Thank you very much in advance.

Regards, Andreas

``````Function CountByColor(CellColor As Range, CountRange As Range)
Application.Volatile
Dim ICol As Integer
Dim TCell As Range
ICol = CellColor.Interior.ColorIndex
For Each TCell In CountRange
If ICol = TCell.Interior.ColorIndex Then
CountByColor = CountByColor + 1
End If
Next TCell
End Function
``````
0
Question by:AndreasHermle
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 3
• 2

LVL 27

Expert Comment

ID: 39861981
``````Function CountByColor(CellColor As Range, CountRange As Range)
Application.Volatile
Dim ICol As Integer
Dim TCell As Range
ICol = CellColor.Interior.ColorIndex
For Each TCell In .CountRange
If ICol = TCell.Interior.ColorIndex Then
CountByColor = CountByColor + 1
End If
Next TCell
End Function

Sub Demo()
Dim rng As Range
rng = Application.InputBox("Please enter the range to count.", "Demo", , , , , , 8)
Sheets("Results").Range("B7") = CountByColor(Sheets("Evaluation").Range("E5"), Sheets("Evaluation").rng)
End Sub
``````
0

Author Comment

ID: 39862090

thank you very much for your great and swift support.

I am afraid to tell you that the code is throwing an error code on line 15: Error Code 91.

I am doing some more testing.

Again, thank you very much. Regards, Andreas
0

LVL 27

Accepted Solution

ID: 39862254
Sorry my bad. Either one of these will work.

``````Function CountByColor(CellColor As Range, CountRange As Range)
Application.Volatile
Dim ICol As Integer
Dim TCell As Range
ICol = CellColor.Interior.ColorIndex
For Each TCell In CountRange
If ICol = TCell.Interior.ColorIndex Then
CountByColor = CountByColor + 1
End If
Next TCell
End Function

Sub Demo1()
Dim strRng As String
strRng = InputBox("Please enter the range to count.", "Demo")
Sheets("Results").Range("B7") = CountByColor(Sheets("Evaluation").Range("E5"), Range(strRng))
End Sub

Sub Demo2()
Dim rng As Range
Set rng = Application.InputBox("Please enter the range to count.", "Demo", , , , , , 8)
Sheets("Results").Range("B7") = CountByColor(Sheets("Evaluation").Range("E5"), rng)
End Sub
``````
0

Author Closing Comment

ID: 39862388
ok, macro shadow, great.  This did the  trick. Thank you very much for your great and professional support. I really appreciate it. Regards, Andreas
0

LVL 27

Expert Comment

ID: 39862390
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
###### Suggested Courses
Course of the Month6 days, 16 hours left to enroll