Solved

Count by Color using VBA

Posted on 2014-02-15
5
357 Views
Last Modified: 2014-02-16
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

Open in new window

0
Comment
Question by:AndreasHermle
  • 3
  • 2
5 Comments
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
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

Open in new window

0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi MacroShadow,  

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 26

Accepted Solution

by:
MacroShadow earned 500 total points
Comment Utility
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

Open in new window

0
 

Author Closing Comment

by:AndreasHermle
Comment Utility
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 26

Expert Comment

by:MacroShadow
Comment Utility
Glad to help:)
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now