Counting Color Cells

[MC82]

I am trying to practice writing macros by creating some of these from scratch. I ran into a problem and I was hoping someone here could help.

Here is how I currently use it:
You select a region, then while holding down ctrl, click on the color of the cell in the selection in which you would like to count. (if it is the first cell you selected, you do not have to reselect the color)

The macro should come back with the color and the number of cells with that color.

Problem:
- This macro does not seem to display the correct count when I scroll down the page a little and select the whole column (the colored cell i want should be the first in the first visible row of the column)

- If I select the cells going from the bottom up, the count is incorrect as well.

Please Login or Register  to view this content.

If anybody can help, it would be greatly appreciated.

[Tom Ogilvy]

Try it this way:

Sub CountColors()
Dim rAllRange As Range
Dim rAllRangeUsed As Range
Dim Cnt As Integer
Dim rCell As Range
Dim clr As String

On Error Resume Next
Set rAllRange = Intersect(Selection, Selection)
' Only examine the UsedRange
' portion of the selection
Set rAllRangeUsed = Intersect(ActiveSheet _
.UsedRange, rAllRange)
If rAllRange.Cells.Count < 2 Then
MsgBox "Your selection is not valid", vbInformation
On Error GoTo 0
Exit Sub
End If

Application.Calculation = xlCalculationManual

Cnt = 0
For Each rCell In rAllRangeUsed
If rCell.Interior.ColorIndex = ActiveCell.Interior.ColorIndex Then
Cnt = Cnt + 1
End If
Next rCell


If ActiveCell.Interior.ColorIndex = 1 Then
clr = "Black"
ElseIf ActiveCell.Interior.ColorIndex = 53 Then
clr = "Brown"
ElseIf ActiveCell.Interior.ColorIndex = 52 Then
clr = "Olive Green"
ElseIf ActiveCell.Interior.ColorIndex = 51 Then
clr = "Dark Green"
ElseIf ActiveCell.Interior.ColorIndex = 49 Then
clr = "Dark Teal"
ElseIf ActiveCell.Interior.ColorIndex = 11 Then
clr = "Dark Blue"
ElseIf ActiveCell.Interior.ColorIndex = 55 Then
clr = "Indigo"
ElseIf ActiveCell.Interior.ColorIndex = 56 Then
clr = "Gray [80%]"
ElseIf ActiveCell.Interior.ColorIndex = 9 Then
clr = "Dark Red"
ElseIf ActiveCell.Interior.ColorIndex = 46 Then
clr = "Orange"
ElseIf ActiveCell.Interior.ColorIndex = 12 Then
clr = "Dark yellow/Green"
ElseIf ActiveCell.Interior.ColorIndex = 10 Then
clr = "Green"
ElseIf ActiveCell.Interior.ColorIndex = 14 Then
clr = "Teal"
ElseIf ActiveCell.Interior.ColorIndex = 5 Then
clr = "Blue"
ElseIf ActiveCell.Interior.ColorIndex = 47 Then
clr = "Blue-Gray"
ElseIf ActiveCell.Interior.ColorIndex = 16 Then
clr = "Gray [50%]"
ElseIf ActiveCell.Interior.ColorIndex = 3 Then
clr = "Red"
ElseIf ActiveCell.Interior.ColorIndex = 45 Then
clr = "Light Orange"
ElseIf ActiveCell.Interior.ColorIndex = 43 Then
clr = "Lime Colored"
ElseIf ActiveCell.Interior.ColorIndex = 50 Then
clr = "Sea Green Colored"
ElseIf ActiveCell.Interior.ColorIndex = 42 Then
clr = "Aqua Colored"
ElseIf ActiveCell.Interior.ColorIndex = 41 Then
clr = "Light Blue"
ElseIf ActiveCell.Interior.ColorIndex = 13 Then
clr = "Violet"
ElseIf ActiveCell.Interior.ColorIndex = 48 Then
clr = "Gray [40%]"
ElseIf ActiveCell.Interior.ColorIndex = 7 Then
clr = "Pink"
ElseIf ActiveCell.Interior.ColorIndex = 44 Then
clr = "Gold Colored"
ElseIf ActiveCell.Interior.ColorIndex = 6 Then
clr = "Yellow"
ElseIf ActiveCell.Interior.ColorIndex = 4 Then
clr = "Bright Green"
ElseIf ActiveCell.Interior.ColorIndex = 8 Then
clr = "Turquoise"
ElseIf ActiveCell.Interior.ColorIndex = 33 Then
clr = "Sky Blue"
ElseIf ActiveCell.Interior.ColorIndex = 54 Then
clr = "Plum Colored"
ElseIf ActiveCell.Interior.ColorIndex = 15 Then
clr = "Gray [25%]"
ElseIf ActiveCell.Interior.ColorIndex = 38 Then
clr = "Rose Colored"
ElseIf ActiveCell.Interior.ColorIndex = 40 Then
clr = "Tan Colored"
ElseIf ActiveCell.Interior.ColorIndex = 36 Then
clr = "Light Yellow"
ElseIf ActiveCell.Interior.ColorIndex = 35 Then
clr = "Light Green"
ElseIf ActiveCell.Interior.ColorIndex = 34 Then
clr = "Light Turquoise"
ElseIf ActiveCell.Interior.ColorIndex = 37 Then
clr = "Pale Blue"
ElseIf ActiveCell.Interior.ColorIndex = 39 Then
clr = "Lavender Colored"
ElseIf ActiveCell.Interior.ColorIndex = 2 Then
clr = "White"
ElseIf ActiveCell.Interior.ColorIndex = -4142 Then
clr = "Uncolored"
Else
clr = "Other Colored"
End If


MsgBox "There Are " & Cnt & " " & clr & " Cells In Your Selection"



Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
End Sub

--
Regards,
Tom Ogilvy


"MC82" wrote:

>
> I am trying to practice writing macros by creating some of these from
> scratch. I ran into a problem and I was hoping someone here could
> help.
>
> HERE IS HOW I CURRENTLY USE IT:
> You select a region, then while holding down ctrl, click on the color
> of the cell in the selection in which you would like to count. (if it
> is the first cell you selected, you do not have to reselect the color)
>
> The macro should come back with the color and the number of cells with
> that color.
>
> PROBLEM:
> - This macro does not seem to display the correct count when I scroll
> down the page a little and select the whole column (the colored cell i
> want should be the first in the first visible row of the column)
>
> - If I select the cells going from the bottom up, the count is
> incorrect as well.
>
>
> Code:
> --------------------
>
> Sub CountColors()
> Dim rAllRange As Range
> Dim aRange As Range
> Dim strAdd As Range
> Dim Cnt As Integer
> Dim rCell As Range
> Dim M1 As Boolean
> Dim Clr As String
> Dim bEntireColumn As Boolean
> Dim bEntireRow As Boolean
>
> With Selection
> bEntireColumn = .Address = .EntireColumn.Address
> bEntireRow = .Address = .EntireRow.Address
> End With
>
> On Error Resume Next
> Set rAllRange = Selection
>
> If rAllRange.Cells.Count < 2 Then
> MsgBox "Your selection is not valid", vbInformation
> On Error GoTo 0
> Exit Sub
> End If
>
> Application.Calculation = xlCalculationManual
>
> Cnt = 0
> For Each rCell In rAllRange
> If Cnt = 0 Then
> If rCell.Address = ActiveCell.Address Then
> M1 = True
> Else
> M1 = False
> End If
> End If
>
> If rCell.Interior.ColorIndex = ActiveCell.Interior.ColorIndex Then
> Cnt = Cnt + 1
> End If
> Next rCell
>
> If ActiveCell.Interior.ColorIndex = 1 Then
> Clr = "Black"
> ElseIf ActiveCell.Interior.ColorIndex = 53 Then
> Clr = "Brown"
> ElseIf ActiveCell.Interior.ColorIndex = 52 Then
> Clr = "Olive Green"
> ElseIf ActiveCell.Interior.ColorIndex = 51 Then
> Clr = "Dark Green"
> ElseIf ActiveCell.Interior.ColorIndex = 49 Then
> Clr = "Dark Teal"
> ElseIf ActiveCell.Interior.ColorIndex = 11 Then
> Clr = "Dark Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 55 Then
> Clr = "Indigo"
> ElseIf ActiveCell.Interior.ColorIndex = 56 Then
> Clr = "Gray [80%]"
> ElseIf ActiveCell.Interior.ColorIndex = 9 Then
> Clr = "Dark Red"
> ElseIf ActiveCell.Interior.ColorIndex = 46 Then
> Clr = "Orange"
> ElseIf ActiveCell.Interior.ColorIndex = 12 Then
> Clr = "Dark yellow/Green"
> ElseIf ActiveCell.Interior.ColorIndex = 10 Then
> Clr = "Green"
> ElseIf ActiveCell.Interior.ColorIndex = 14 Then
> Clr = "Teal"
> ElseIf ActiveCell.Interior.ColorIndex = 5 Then
> Clr = "Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 47 Then
> Clr = "Blue-Gray"
> ElseIf ActiveCell.Interior.ColorIndex = 16 Then
> Clr = "Gray [50%]"
> ElseIf ActiveCell.Interior.ColorIndex = 3 Then
> Clr = "Red"
> ElseIf ActiveCell.Interior.ColorIndex = 45 Then
> Clr = "Light Orange"
> ElseIf ActiveCell.Interior.ColorIndex = 43 Then
> Clr = "Lime Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 50 Then
> Clr = "Sea Green Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 42 Then
> Clr = "Aqua Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 41 Then
> Clr = "Light Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 13 Then
> Clr = "Violet"
> ElseIf ActiveCell.Interior.ColorIndex = 48 Then
> Clr = "Gray [40%]"
> ElseIf ActiveCell.Interior.ColorIndex = 7 Then
> Clr = "Pink"
> ElseIf ActiveCell.Interior.ColorIndex = 44 Then
> Clr = "Gold Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 6 Then
> Clr = "Yellow"
> ElseIf ActiveCell.Interior.ColorIndex = 4 Then
> Clr = "Bright Green"
> ElseIf ActiveCell.Interior.ColorIndex = 8 Then
> Clr = "Turquoise"
> ElseIf ActiveCell.Interior.ColorIndex = 33 Then
> Clr = "Sky Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 54 Then
> Clr = "Plum Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 15 Then
> Clr = "Gray [25%]"
> ElseIf ActiveCell.Interior.ColorIndex = 38 Then
> Clr = "Rose Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 40 Then
> Clr = "Tan Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 36 Then
> Clr = "Light Yellow"
> ElseIf ActiveCell.Interior.ColorIndex = 35 Then
> Clr = "Light Green"
> ElseIf ActiveCell.Interior.ColorIndex = 34 Then
> Clr = "Light Turquoise"
> ElseIf ActiveCell.Interior.ColorIndex = 37 Then
> Clr = "Pale Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 39 Then
> Clr = "Lavender Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 2 Then
> Clr = "White"
> ElseIf ActiveCell.Interior.ColorIndex = -4142 Then
> Clr = "Uncolored"
> Else
> Clr = "Other Colored"
> End If
>
> If M1 = False Then
> MsgBox "There Are " & Cnt - 1 & " " & Clr & " Cells In Your Selection"
> Else
> If bEntireColumn Then
> MsgBox "There Are " & Cnt & " " & Clr & " Cells In Your Selection"
> ElseIf bEntireRow Then
> MsgBox "There Are " & Cnt - 1 & " " & Clr & " Cells In Your Selection"
> Else
> MsgBox "There Are " & Cnt & " " & Clr & " Cells In Your Selection"
> End If
>
> End If
>
> Application.Calculation = xlCalculationAutomatic
> On Error GoTo 0
> End Sub
>
> --------------------
>
>
> If anybody can help, it would be greatly appreciated.
>
>
> --
> MC82
> ------------------------------------------------------------------------
> MC82's Profile: http://www.excelforum.com/member.php...o&userid=18682
> View this thread: http://www.excelforum.com/showthread...hreadid=538142
>
>

[Jim Thomlinson]

Here is a good reference on counting colours...

http://www.xldynamic.com/source/xld.ColourCounter.html
--
HTH...

Jim Thomlinson


"MC82" wrote:

>
> I am trying to practice writing macros by creating some of these from
> scratch. I ran into a problem and I was hoping someone here could
> help.
>
> HERE IS HOW I CURRENTLY USE IT:
> You select a region, then while holding down ctrl, click on the color
> of the cell in the selection in which you would like to count. (if it
> is the first cell you selected, you do not have to reselect the color)
>
> The macro should come back with the color and the number of cells with
> that color.
>
> PROBLEM:
> - This macro does not seem to display the correct count when I scroll
> down the page a little and select the whole column (the colored cell i
> want should be the first in the first visible row of the column)
>
> - If I select the cells going from the bottom up, the count is
> incorrect as well.
>
>
> Code:
> --------------------
>
> Sub CountColors()
> Dim rAllRange As Range
> Dim aRange As Range
> Dim strAdd As Range
> Dim Cnt As Integer
> Dim rCell As Range
> Dim M1 As Boolean
> Dim Clr As String
> Dim bEntireColumn As Boolean
> Dim bEntireRow As Boolean
>
> With Selection
> bEntireColumn = .Address = .EntireColumn.Address
> bEntireRow = .Address = .EntireRow.Address
> End With
>
> On Error Resume Next
> Set rAllRange = Selection
>
> If rAllRange.Cells.Count < 2 Then
> MsgBox "Your selection is not valid", vbInformation
> On Error GoTo 0
> Exit Sub
> End If
>
> Application.Calculation = xlCalculationManual
>
> Cnt = 0
> For Each rCell In rAllRange
> If Cnt = 0 Then
> If rCell.Address = ActiveCell.Address Then
> M1 = True
> Else
> M1 = False
> End If
> End If
>
> If rCell.Interior.ColorIndex = ActiveCell.Interior.ColorIndex Then
> Cnt = Cnt + 1
> End If
> Next rCell
>
> If ActiveCell.Interior.ColorIndex = 1 Then
> Clr = "Black"
> ElseIf ActiveCell.Interior.ColorIndex = 53 Then
> Clr = "Brown"
> ElseIf ActiveCell.Interior.ColorIndex = 52 Then
> Clr = "Olive Green"
> ElseIf ActiveCell.Interior.ColorIndex = 51 Then
> Clr = "Dark Green"
> ElseIf ActiveCell.Interior.ColorIndex = 49 Then
> Clr = "Dark Teal"
> ElseIf ActiveCell.Interior.ColorIndex = 11 Then
> Clr = "Dark Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 55 Then
> Clr = "Indigo"
> ElseIf ActiveCell.Interior.ColorIndex = 56 Then
> Clr = "Gray [80%]"
> ElseIf ActiveCell.Interior.ColorIndex = 9 Then
> Clr = "Dark Red"
> ElseIf ActiveCell.Interior.ColorIndex = 46 Then
> Clr = "Orange"
> ElseIf ActiveCell.Interior.ColorIndex = 12 Then
> Clr = "Dark yellow/Green"
> ElseIf ActiveCell.Interior.ColorIndex = 10 Then
> Clr = "Green"
> ElseIf ActiveCell.Interior.ColorIndex = 14 Then
> Clr = "Teal"
> ElseIf ActiveCell.Interior.ColorIndex = 5 Then
> Clr = "Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 47 Then
> Clr = "Blue-Gray"
> ElseIf ActiveCell.Interior.ColorIndex = 16 Then
> Clr = "Gray [50%]"
> ElseIf ActiveCell.Interior.ColorIndex = 3 Then
> Clr = "Red"
> ElseIf ActiveCell.Interior.ColorIndex = 45 Then
> Clr = "Light Orange"
> ElseIf ActiveCell.Interior.ColorIndex = 43 Then
> Clr = "Lime Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 50 Then
> Clr = "Sea Green Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 42 Then
> Clr = "Aqua Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 41 Then
> Clr = "Light Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 13 Then
> Clr = "Violet"
> ElseIf ActiveCell.Interior.ColorIndex = 48 Then
> Clr = "Gray [40%]"
> ElseIf ActiveCell.Interior.ColorIndex = 7 Then
> Clr = "Pink"
> ElseIf ActiveCell.Interior.ColorIndex = 44 Then
> Clr = "Gold Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 6 Then
> Clr = "Yellow"
> ElseIf ActiveCell.Interior.ColorIndex = 4 Then
> Clr = "Bright Green"
> ElseIf ActiveCell.Interior.ColorIndex = 8 Then
> Clr = "Turquoise"
> ElseIf ActiveCell.Interior.ColorIndex = 33 Then
> Clr = "Sky Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 54 Then
> Clr = "Plum Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 15 Then
> Clr = "Gray [25%]"
> ElseIf ActiveCell.Interior.ColorIndex = 38 Then
> Clr = "Rose Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 40 Then
> Clr = "Tan Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 36 Then
> Clr = "Light Yellow"
> ElseIf ActiveCell.Interior.ColorIndex = 35 Then
> Clr = "Light Green"
> ElseIf ActiveCell.Interior.ColorIndex = 34 Then
> Clr = "Light Turquoise"
> ElseIf ActiveCell.Interior.ColorIndex = 37 Then
> Clr = "Pale Blue"
> ElseIf ActiveCell.Interior.ColorIndex = 39 Then
> Clr = "Lavender Colored"
> ElseIf ActiveCell.Interior.ColorIndex = 2 Then
> Clr = "White"
> ElseIf ActiveCell.Interior.ColorIndex = -4142 Then
> Clr = "Uncolored"
> Else
> Clr = "Other Colored"
> End If
>
> If M1 = False Then
> MsgBox "There Are " & Cnt - 1 & " " & Clr & " Cells In Your Selection"
> Else
> If bEntireColumn Then
> MsgBox "There Are " & Cnt & " " & Clr & " Cells In Your Selection"
> ElseIf bEntireRow Then
> MsgBox "There Are " & Cnt - 1 & " " & Clr & " Cells In Your Selection"
> Else
> MsgBox "There Are " & Cnt & " " & Clr & " Cells In Your Selection"
> End If
>
> End If
>
> Application.Calculation = xlCalculationAutomatic
> On Error GoTo 0
> End Sub
>
> --------------------
>
>
> If anybody can help, it would be greatly appreciated.
>
>
> --
> MC82
> ------------------------------------------------------------------------
> MC82's Profile: http://www.excelforum.com/member.php...o&userid=18682
> View this thread: http://www.excelforum.com/showthread...hreadid=538142
>
>

[MC82]

Thanks for trying to help guys. Didnt really get to the bottom of the problem, but I did learn a few new things.