PDA

View Full Version : Solved: calculating a %, based on the bg color of a cell



ironj32
08-27-2008, 11:44 AM
Is it possible to create a calculation in a cell, "C4", based upon the fill colors of cells on a separate work sheet? For example: Any time a task has been completed a cell color is changed to "Green"...otherwise the cell colors are "Red" or "Yellow".

I would like to be able to take a count of all of the cells in the range of B4:B20 on Sheet2, and determine the percent complete, based upon color.

Is this possible? If it is, any help with coding would be greatly appreciated! Thanks.

mdmackillop
08-27-2008, 12:02 PM
Option Explicit

Sub test()
Dim arr(55)
Dim cel As Range
Dim Col As Long, i As Long, x As Long
Dim msg As String

For Each cel In Sheets(2).Range("B4:B20")
Col = cel.Interior.ColorIndex
arr(Col) = arr(Col) + 1
x = x + 1
Next

For i = 0 To 55
If arr(i) <> 0 Then msg = msg & i & " - " & 100 * arr(i) / x & "%" & vbCr
Next
MsgBox msg

End Sub

Bob Phillips
08-27-2008, 01:31 PM
See http://www.xldynamic.com/source/xld.ColourCounter.html

ironj32
08-29-2008, 07:01 AM
Thanks a million mdmackillop and xld. Below is the code that I ended up using. So far it's working great.

Function Camp1_ir_Finish()
Dim arr(56)
Dim cel As Range
Dim Col As Long, i As Long, x As Long
Dim cl1 As Integer
Dim ws As Worksheet

Set ws = Worksheets("Summary")

For Each cel In Sheets("Detail").Range("ir_finish1")
Col = cel.Interior.ColorIndex
arr(Col) = arr(Col) + 1
x = x + 1
Next

For i = 4 To 4
If arr(i) <> 0 Then
ws.Cells(4, 3).Value = arr(i) / x
Else
ws.Cells(4, 3).Value = 0
End If
Next
End Function