Sub MakeMean()
Dim rng As Range
Dim c As Range
Dim count As Integer
Dim newMean As Double
Dim meanArray() As Double
Dim arraySize As Integer
count = 0

Set rng = Range("A1:F1")

ReDim meanArray(1 To rng.count)

For Each c In rng

v = c.Value

If Not IsEmpty(v) And IsNumeric(v) Then
Select Case c.Font.ColorIndex
Case xlAutomatic, 1
'arraySize = count
count = count + 1
meanArray(count) = v
End Select

End If
Next c

ReDim Preserve meanArray(1 To count)

newMean = Application.WorksheetFunction.Average(meanArray)

Cells(1, "I") = newMean
End Sub

Worked for me.

--
Regards,
Tom Ogilvy





"chick-racer" wrote in message
...

yes that is entirely true... Thank you for your help.. i have used your
ideas to make this short one... but it doesnt seem to be working
yet....


here is what i've done so far....

Dim rng As Range
Dim c As Range
Dim count As Integer
Dim newMean As Double
Dim meanArray() As Double
Dim arraySize As Integer
count = 1

Set rng = Range("A1:F1") ' I have much bigger range that this will be
filtering through.. just using this to test right now.

For Each c In rng

v = c.Value

If (IsEmpty(v) = False) And IsNumeric(v) Then
Select Case c.Font.ColorIndex
Case xlAutomatic, 1
'arraySize = count

meanArray(count) = v

count = count + 1

End Select

End If
Next c


newMean = Application.WorksheetFunction.Average(meanArray)

Cells(1, "I") = newMean

End Sub


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from http://www.ExcelForum.com/