Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > count colored cells
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1
Default count colored cells

i have been trying to figure out a macro that counts cells with an
interior color other than white and display the results in a message
box.

any suggestions are highly appreciated!
thanks,
johannes


--
apx2001
------------------------------------------------------------------------
apx2001's Profile: http://www.excelforum.com/member.php...o&userid=32306
View this thread: http://www.excelforum.com/showthread...hreadid=520593

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,272
Default count colored cells
See http://www.xldynamic.com/source/xld.ColourCounter.html for a working
solution

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"apx2001" wrote in
message ...

i have been trying to figure out a macro that counts cells with an
interior color other than white and display the results in a message
box.

any suggestions are highly appreciated!
thanks,
johannes


--
apx2001
------------------------------------------------------------------------
apx2001's Profile:
http://www.excelforum.com/member.php...o&userid=32306
View this thread: http://www.excelforum.com/showthread...hreadid=520593



Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,452
Default count colored cells
Sub test()

Dim c As Range
Dim i As Long

For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex < -4142 Then
i = i + 1
End If
Next

MsgBox i & " cells with a colour format", , _
"counting coloured cells"

End Sub


RBS


"apx2001" wrote in
message ...

i have been trying to figure out a macro that counts cells with an
interior color other than white and display the results in a message
box.

any suggestions are highly appreciated!
thanks,
johannes


--
apx2001
------------------------------------------------------------------------
apx2001's Profile:
http://www.excelforum.com/member.php...o&userid=32306
View this thread: http://www.excelforum.com/showthread...hreadid=520593


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1
Default count colored cells

thank you for your help and the reference!

best,
johannes


--
apx2001
------------------------------------------------------------------------
apx2001's Profile: http://www.excelforum.com/member.php...o&userid=32306
View this thread: http://www.excelforum.com/showthread...hreadid=520593

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,452
Default count colored cells
This gives more information:

Sub test()

Dim c As Range
Dim i As Long
Dim n As Long
Dim vIndex
Dim nMax As Long
Dim arrColours(1 To 255, 1 To 2) As Long
Dim strColours As String

For Each c In ActiveSheet.UsedRange
vIndex = c.Interior.ColorIndex
For n = 1 To nMax + 1
If vIndex = arrColours(n, 1) Then
arrColours(n, 2) = arrColours(n, 2) + 1
If n nMax Then
nMax = n
End If
Exit For
End If
If arrColours(n, 1) = 0 Then
arrColours(n, 1) = vIndex
arrColours(n, 2) = 1
nMax = n
End If
Next
If vIndex 0 Then
i = i + 1
End If
Next

For n = 1 To nMax
If n 1 Then
strColours = strColours & vbCrLf & _
arrColours(n, 1) & vbTab & arrColours(n, 2)
Else
strColours = arrColours(n, 1) & vbTab & arrColours(n, 2)
End If
Next

MsgBox i & " cells with a colour format" & _
vbCrLf & vbCrLf & _
"index" & vbTab & "count" & vbCrLf & _
"-----------------------" & vbCrLf & _
strColours, , _
"counting coloured cells"

End Sub


RBS



"RB Smissaert" wrote in message
...
Sub test()

Dim c As Range
Dim i As Long

For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex < -4142 Then
i = i + 1
End If
Next

MsgBox i & " cells with a colour format", , _
"counting coloured cells"

End Sub


RBS


"apx2001" wrote in
message ...

i have been trying to figure out a macro that counts cells with an
interior color other than white and display the results in a message
box.

any suggestions are highly appreciated!
thanks,
johannes


--
apx2001
------------------------------------------------------------------------
apx2001's Profile:
http://www.excelforum.com/member.php...o&userid=32306
View this thread:
http://www.excelforum.com/showthread...hreadid=520593



Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,452
Default count colored cells
Added a counter, just for in case you were dealing with a very large range.

Sub CountColours()

Dim c As Range
Dim i As Long
Dim n As Long
Dim x As Long
Dim vIndex
Dim nMax As Long
Dim arrColours(1 To 255, 1 To 2) As Long
Dim strColours As String
Dim lCellCount As Long

lCellCount = ActiveSheet.UsedRange.Cells.Count

For Each c In ActiveSheet.UsedRange
vIndex = c.Interior.ColorIndex
For n = 1 To nMax + 1
If vIndex = arrColours(n, 1) Then
arrColours(n, 2) = arrColours(n, 2) + 1
If n nMax Then
nMax = n
End If
Exit For
End If
If arrColours(n, 1) = 0 Then
arrColours(n, 1) = vIndex
arrColours(n, 2) = 1
nMax = n
End If
Next
If vIndex 0 Then
i = i + 1
End If
x = x + 1
If x Mod lCellCount \ 100 = 0 Then
Application.StatusBar = " " & _
Round((x / lCellCount), 2) _
* 100 & _
" % done"
End If
Next

For n = 1 To nMax
If n 1 Then
strColours = strColours & vbCrLf & _
arrColours(n, 1) & vbTab & _
arrColours(n, 2)
Else
strColours = arrColours(n, 1) & vbTab & _
arrColours(n, 2)
End If
Next

MsgBox i & " cells with a colour format" & _
vbCrLf & vbCrLf & _
"index" & vbTab & "count" & vbCrLf & _
"-----------------------" & vbCrLf & _
strColours, , _
"counting coloured cells"

Application.StatusBar = False

End Sub


RBS


"RB Smissaert" wrote in message
...
This gives more information:

Sub test()

Dim c As Range
Dim i As Long
Dim n As Long
Dim vIndex
Dim nMax As Long
Dim arrColours(1 To 255, 1 To 2) As Long
Dim strColours As String

For Each c In ActiveSheet.UsedRange
vIndex = c.Interior.ColorIndex
For n = 1 To nMax + 1
If vIndex = arrColours(n, 1) Then
arrColours(n, 2) = arrColours(n, 2) + 1
If n nMax Then
nMax = n
End If
Exit For
End If
If arrColours(n, 1) = 0 Then
arrColours(n, 1) = vIndex
arrColours(n, 2) = 1
nMax = n
End If
Next
If vIndex 0 Then
i = i + 1
End If
Next

For n = 1 To nMax
If n 1 Then
strColours = strColours & vbCrLf & _
arrColours(n, 1) & vbTab & arrColours(n, 2)
Else
strColours = arrColours(n, 1) & vbTab & arrColours(n, 2)
End If
Next

MsgBox i & " cells with a colour format" & _
vbCrLf & vbCrLf & _
"index" & vbTab & "count" & vbCrLf & _
"-----------------------" & vbCrLf & _
strColours, , _
"counting coloured cells"

End Sub


RBS



"RB Smissaert" wrote in message
...
Sub test()

Dim c As Range
Dim i As Long

For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex < -4142 Then
i = i + 1
End If
Next

MsgBox i & " cells with a colour format", , _
"counting coloured cells"

End Sub


RBS


"apx2001" wrote in
message ...

i have been trying to figure out a macro that counts cells with an
interior color other than white and display the results in a message
box.

any suggestions are highly appreciated!
thanks,
johannes


--
apx2001
------------------------------------------------------------------------
apx2001's Profile:
http://www.excelforum.com/member.php...o&userid=32306
View this thread:
http://www.excelforum.com/showthread...hreadid=520593




Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,452
Default count colored cells
Fixed a division by zero bug:

Sub CountColours()

Dim c As Range
Dim i As Long
Dim n As Long
Dim x As Long
Dim vIndex
Dim nMax As Long
Dim arrColours(1 To 255, 1 To 2) As Long
Dim strColours As String
Dim lCellCount As Long

lCellCount = ActiveSheet.UsedRange.Cells.Count

For Each c In ActiveSheet.UsedRange
vIndex = c.Interior.ColorIndex
For n = 1 To nMax + 1
If vIndex = arrColours(n, 1) Then
arrColours(n, 2) = arrColours(n, 2) + 1
If n nMax Then
nMax = n
End If
Exit For
End If
If arrColours(n, 1) = 0 Then
arrColours(n, 1) = vIndex
arrColours(n, 2) = 1
nMax = n
End If
Next
If vIndex 0 Then
i = i + 1
End If
If lCellCount 10000 Then
x = x + 1
If x Mod lCellCount \ 100 = 0 Then
Application.StatusBar = " " & _
Round((x / lCellCount), 2) _
* 100 & _
" % done"
End If
End If
Next

For n = 1 To nMax
If n 1 Then
strColours = strColours & vbCrLf & _
arrColours(n, 1) & vbTab & _
arrColours(n, 2)
Else
strColours = arrColours(n, 1) & vbTab & _
arrColours(n, 2)
End If
Next

MsgBox "Used range with " & lCellCount & " cells." & _
vbCrLf & _
i & " cells with a colour format." & _
vbCrLf & vbCrLf & _
"index" & vbTab & "count" & vbCrLf & _
"-----------------------------------" & _
vbCrLf & _
strColours, , _
"counting coloured cells"

If lCellCount 10000 Then
Application.StatusBar = False
End If

End Sub


RBS


"RB Smissaert" wrote in message
...
Added a counter, just for in case you were dealing with a very large
range.

Sub CountColours()

Dim c As Range
Dim i As Long
Dim n As Long
Dim x As Long
Dim vIndex
Dim nMax As Long
Dim arrColours(1 To 255, 1 To 2) As Long
Dim strColours As String
Dim lCellCount As Long

lCellCount = ActiveSheet.UsedRange.Cells.Count

For Each c In ActiveSheet.UsedRange
vIndex = c.Interior.ColorIndex
For n = 1 To nMax + 1
If vIndex = arrColours(n, 1) Then
arrColours(n, 2) = arrColours(n, 2) + 1
If n nMax Then
nMax = n
End If
Exit For
End If
If arrColours(n, 1) = 0 Then
arrColours(n, 1) = vIndex
arrColours(n, 2) = 1
nMax = n
End If
Next
If vIndex 0 Then
i = i + 1
End If
x = x + 1
If x Mod lCellCount \ 100 = 0 Then
Application.StatusBar = " " & _
Round((x / lCellCount), 2) _
* 100 & _
" % done"
End If
Next

For n = 1 To nMax
If n 1 Then
strColours = strColours & vbCrLf & _
arrColours(n, 1) & vbTab & _
arrColours(n, 2)
Else
strColours = arrColours(n, 1) & vbTab & _
arrColours(n, 2)
End If
Next

MsgBox i & " cells with a colour format" & _
vbCrLf & vbCrLf & _
"index" & vbTab & "count" & vbCrLf & _
"-----------------------" & vbCrLf & _
strColours, , _
"counting coloured cells"

Application.StatusBar = False

End Sub


RBS


"RB Smissaert" wrote in message
...
This gives more information:

Sub test()

Dim c As Range
Dim i As Long
Dim n As Long
Dim vIndex
Dim nMax As Long
Dim arrColours(1 To 255, 1 To 2) As Long
Dim strColours As String

For Each c In ActiveSheet.UsedRange
vIndex = c.Interior.ColorIndex
For n = 1 To nMax + 1
If vIndex = arrColours(n, 1) Then
arrColours(n, 2) = arrColours(n, 2) + 1
If n nMax Then
nMax = n
End If
Exit For
End If
If arrColours(n, 1) = 0 Then
arrColours(n, 1) = vIndex
arrColours(n, 2) = 1
nMax = n
End If
Next
If vIndex 0 Then
i = i + 1
End If
Next

For n = 1 To nMax
If n 1 Then
strColours = strColours & vbCrLf & _
arrColours(n, 1) & vbTab & arrColours(n, 2)
Else
strColours = arrColours(n, 1) & vbTab & arrColours(n, 2)
End If
Next

MsgBox i & " cells with a colour format" & _
vbCrLf & vbCrLf & _
"index" & vbTab & "count" & vbCrLf & _
"-----------------------" & vbCrLf & _
strColours, , _
"counting coloured cells"

End Sub


RBS



"RB Smissaert" wrote in message
...
Sub test()

Dim c As Range
Dim i As Long

For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex < -4142 Then
i = i + 1
End If
Next

MsgBox i & " cells with a colour format", , _
"counting coloured cells"

End Sub


RBS


"apx2001" wrote
in message ...

i have been trying to figure out a macro that counts cells with an
interior color other than white and display the results in a message
box.

any suggestions are highly appreciated!
thanks,
johannes


--
apx2001
------------------------------------------------------------------------
apx2001's Profile:
http://www.excelforum.com/member.php...o&userid=32306
View this thread:
http://www.excelforum.com/showthread...hreadid=520593





Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
How do you count colored cells? Clueless78217 Excel Worksheet Functions 2 November 25th 08 04:35 AM
count colored cells? DKY Excel Worksheet Functions 21 January 19th 06 09:47 PM
How to Count only Colored cells WM_1956 Excel Programming 2 December 26th 05 01:35 PM
Count non-colored cells Ken G Excel Discussion (Misc queries) 3 January 2nd 05 12:42 PM
Count or sum colored cells brightgirl Excel Worksheet Functions 2 December 7th 04 03:34 PM


All times are GMT +1. The time now is 10:26 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement