need help with a VBA program to average cells by color

[jason061872]

1st, I know next to nothing about VBA so I am not even sure if this is possible. I am looking to create a VBA formula that will average values within a cell by the color of the cell:
The cells will be in one column
The cell color in row 1, may or may not be different than the cell color of row 2, etc. throughout the sheet (I am using 8 different colors – 1 color per category)
The cells in the column will not always contain values – I need the program to not include those cells in the average calculation.
Any help you could provide would be greatly appreciated!

 

[jason061872]

I just found this code - will it do what I want?

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

 

[DanteAmor]

You must use it as follows


<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td > </td><td style="background-color:#00b0f0; text-align:right; ">2</td><td > </td><td > </td><td style="background-color:#ffff00; "> </td><td style="text-align:right; ">12</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td > </td><td style="background-color:#ffff00; text-align:right; ">4</td><td > </td><td > </td><td style="background-color:#92d050; "> </td><td style="text-align:right; ">20.5</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td > </td><td style="background-color:#00b0f0; text-align:right; ">5</td><td > </td><td > </td><td style="background-color:#00b0f0; "> </td><td style="text-align:right; ">7</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td > </td><td style="background-color:#00b0f0; text-align:right; ">9</td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td > </td><td style="background-color:#ffff00; text-align:right; ">7</td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td > </td><td style="background-color:#92d050; text-align:right; ">18</td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td > </td><td style="text-align:right; ">15</td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td > </td><td style="background-color:#ffff00; text-align:right; ">25</td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >12</td><td > </td><td style="background-color:#92d050; text-align:right; ">23</td><td > </td><td > </td><td > </td><td > </td></tr></table><br /><table style="font-family:Arial; font-size:10pt; border-style: groove ;border-color:#00ff00;background-color:#fffcf9; color:#000000; "><tr><td ><b></b></td></tr><tr><td ><table border = "1" cellspacing="0" cellpadding="2" style="font-family:Arial; font-size:9pt;"><tr style="background-color:#cacaca; font-size:10pt;"><td >Cell</td><td >Formula</td></tr><tr><td >F2</td><td >=AVGColor(E2,B2:B12)</td></tr></table></td></tr></table>


Updated function

Function AVGColor(rColor As Range, rng As Range)
  Dim iCol As Integer, C As Range
  Dim vResult As Double, 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
[COLOR=#0000ff]  Next[/COLOR]
  
  If Count = 0 Then
    AVGColor = ""
  Else
    AVGColor = vResult / Count
  End If
End Function

 

[jason061872]

The revised code seems to be working perfectly!! Thank you for your assistance!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.