Looking to count status based on Cell color

[dineshiam]

Hi ,

I have a big set in which i need to count days based on certain colors. I have attached a sample set, please if you can assist with below. I have written the criteria below as well as in the sheet. Thanks.

1) Looking For Approved, Reject Or Partial Status In Column H. Green Color Denotes Approved, Red Is Rejected, And If Both Are Present In One Row Is Partial
2 ) Ron Has Applied 2 Bids, Primary And Secondary
Based On The Color Primary One Should Come As Rejected In Cell H5
And Based On Both Green And Red Color Secondary (Cell H6) Should Come As Partial
3) Number of accepted or rejected bids should be counted in Column I and J respectively based on the color.

[AliGW]

Excel cannot count based on cell colour.

You present us with one problem after another - do you ever give yourself time to have a go at it yourself before asking us?

[dineshiam]

Thank you, currently I am working on different sets today however i tried first and then googled the same problem first. With no specific solution to the problem, I considered posting in the group. I got stuck in counting the colors.

Thank you for the help.

[dineshiam]

finally got an alternate solution with VBA. no direct formula to calculate that. Thanks.

[oeldere]

Please post your solution, for the benefit of all forumusers.

[dineshiam]

Sure,

1. Save excel as macro enabled workbook
2. Press Alt + F11
3. Right click on the sheet name on the upper left of editor page.
4. Go to Insert >> Module and paste below code :
5. Save the workbook. Use CountCellsByColor(range, color code cell)
For eg: If A1 to A11 is the range in which the colors are, and color is in B1 , formula will be
CountCellsByColor(A1:A11,B1)

The code for point 4 is :

Function GetCellColor(xlRange As Range)
Dim indRow, indColumn As Long
Dim arResults()

Application.Volatile

If xlRange Is Nothing Then
Set xlRange = Application.ThisCell
End If

If xlRange.Count > 1 Then
ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
For indRow = 1 To xlRange.Rows.Count
For indColumn = 1 To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color
Next
Next
GetCellColor = arResults
Else
GetCellColor = xlRange.Interior.Color
End If
End Function

Function GetCellFontColor(xlRange As Range)
Dim indRow, indColumn As Long
Dim arResults()

Application.Volatile

If xlRange Is Nothing Then
Set xlRange = Application.ThisCell
End If

If xlRange.Count > 1 Then
ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
For indRow = 1 To xlRange.Rows.Count
For indColumn = 1 To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Font.Color
Next
Next
GetCellFontColor = arResults
Else
GetCellFontColor = xlRange.Font.Color
End If

End Function

Function CountCellsByColor(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellCurrent As Range
Dim cntRes As Long

Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Interior.Color Then
cntRes = cntRes + 1
End If
Next cellCurrent

CountCellsByColor = cntRes
End Function

Function SumCellsByColor(rData As Range, cellRefColor As Range)
Dim indRefColor As Long
Dim cellCurrent As Range
Dim sumRes

Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Interior.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
End If
Next cellCurrent

SumCellsByColor = sumRes
End Function

Function CountCellsByFontColor(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellCurrent As Range
Dim cntRes As Long

Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Font.Color Then
cntRes = cntRes + 1
End If
Next cellCurrent

CountCellsByFontColor = cntRes
End Function

Function SumCellsByFontColor(rData As Range, cellRefColor As Range)
Dim indRefColor As Long
Dim cellCurrent As Range
Dim sumRes

Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Font.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
End If
Next cellCurrent

SumCellsByFontColor = sumRes
End Function

[oeldere]

@dineshiam

Thanks for posting the code.

Please add the code in #6 between tags # according to the forumrules.