Consulting

Results 1 to 4 of 4

Thread: Solved: calculating a %, based on the bg color of a cell

  1. #1

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

    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.

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    [VBA]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
    [/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  4. #4
    Thanks a million mdmackillop and xld. Below is the code that I ended up using. So far it's working great.

    [VBA]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[/VBA]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •