| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Counting Color Cells
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Counting Color Cells
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Counting Color Cells
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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Counting Color Cells
Thanks for trying to help guys. Didnt really get to the bottom of the problem, but I did learn a few new things. -- MC82 ------------------------------------------------------------------------ MC82's Profile: http://www.excelforum.com/member.php...o&userid=18682 View this thread: http://www.excelforum.com/showthread...hreadid=538142 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Counting cells by font color | Excel Discussion (Misc queries) | |||
| Counting cells of a specific color | Excel Worksheet Functions | |||
| counting cells in a row with color highlight | Excel Discussion (Misc queries) | |||
| Counting color filled cells? For an Idiot. | Excel Discussion (Misc queries) | |||
| counting cells by text color | Excel Worksheet Functions | |||
![MC82[_3_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
