Average by color VBA

  • Thread starter Thread starter jlclyde
  • Start date Start date
J

jlclyde

I have read many posts on how to Count cells with fill color and how
to sum based on fill color but how do you do an average? Here is the
code I have now.

Function AVGColor(rColor As Range, Range As Range)
Dim rCell
Dim iCol As Integer
Dim C As Range
Dim vResult As Double

iCol = rColor.Interior.ColorIndex
For Each rCell In Range
If rCell.Interior.ColorIndex = iCol Then
vResult = WorksheetFunction.Sum(rCell, vResult)
End If
Next rCell

For Each C In Range
If C.Interior.ColorIndex = rColor.Interior.ColorIndex Then
Count = Count + 1
End If
Next C

If AVGColor = vResult / Count = Numeric Then
AVGColor = vResult / Count
Else: AVGColor = ""
End If

End Function
Thanks for the help,
Jay
 
Function AVGColor(rColor As Range, rng As Range)
Dim iCol As Integer
Dim C As Range
Dim vResult As Double
Dim Count As Long

iCol = rColor.Interior.ColorIndex
For Each C In rng
If C.Interior.ColorIndex = iCol Then
vResult = WorksheetFunction.Sum(C, vResult)
Count = Count + 1
End If
Next rCell

If Count = 0 Then
AVGColor = ""
Else
AVGColor = vResult / Count
End If

End Function

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
should be

Function AVGColor(rColor As Range, rng As Range)
Dim iCol As Integer
Dim C As Range
Dim vResult As Double
Dim Count As Long

iCol = rColor.Interior.ColorIndex
For Each C In rng
If C.Interior.ColorIndex = iCol Then
vResult = vResult + C.Value
Count = Count + 1
End If
Next rCell

If Count = 0 Then
AVGColor = ""
Else
AVGColor = vResult / Count
End If

End Function

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
should be

Function AVGColor(rColor As Range, rng As Range)
Dim iCol As Integer
Dim C As Range
Dim vResult As Double
Dim Count As Long

iCol = rColor.Interior.ColorIndex
For Each C In rng
If C.Interior.ColorIndex = iCol Then
vResult = vResult + C.Value
Count = Count + 1
End If
Next rCell

If Count = 0 Then
AVGColor = ""
Else
AVGColor = vResult / Count
End If

End Function
Click to expand...
The formula needs to skip blank cells liek the Average formula in
Excel. This Function does what mine does, just more efficiently.
Jay
 
Wouldn't the blanks not be coloured?

Function AVGColor(rColor As Range, rng As Range)
Dim iCol As Integer
Dim C As Range
Dim vResult As Double
Dim Count As Long

iCol = rColor.Interior.ColorIndex
For Each C In rng
If C.Interior.ColorIndex = iCol And IsNumeric(C.Value) Then
vResult = vResult + C.Value
Count = Count + 1
End If
Next rCell

If Count = 0 Then
AVGColor = ""
Else
AVGColor = vResult / Count
End If

End Function


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
Wouldn't the blanks not be coloured?

Function AVGColor(rColor As Range, rng As Range)
Dim iCol As Integer
Dim C As Range
Dim vResult As Double
Dim Count As Long

iCol = rColor.Interior.ColorIndex
For Each C In rng
If C.Interior.ColorIndex = iCol And IsNumeric(C.Value) Then
vResult = vResult + C.Value
Count = Count + 1
End If
Next rCell

If Count = 0 Then
AVGColor = ""
Else
AVGColor = vResult / Count
End If

End Function

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)






- Show quoted text -
Click to expand...

This is what the code shoudl be. Thank you for turing me onto the
right answer.
Jay
If C.Interior.ColorIndex = iCol And IsNumeric(C.Value) And Not
IsEmpty(C.Value) Then
 
jlclyde said:
This is what the code shoudl be. Thank you for turing me onto the
right answer.
Jay
If C.Interior.ColorIndex = iCol And IsNumeric(C.Value) And Not
IsEmpty(C.Value) Then
Click to expand...
Is this for use anywhere in the worksheet and any color? I'm trying it now - I keep getting #Value error. Thanks for your help!
 
Back
Top