Here's a quick-n-dirty function that accepts 6 different operators for

specifying criteria. (watch out for word wrap)

Public Function Average_2Ifs(RangeToAvg As Range, _

Criteria1Range As Range, Criteria1 As Variant, _

Criteria2Range As Range, Criteria2 As Variant) As

Double

' Returns the average of a range of values based on 2 specified

criteria.

' Criteria can be the same range or different ranges.

Dim sz As String, c As Range

Dim dValues As Double, iCount As Integer

Dim v1 As Variant, v2 As Variant

'Check combined operators first

If InStr(1, Criteria2, "<=", vbTextCompare) > 0 Then sz = "<=":GoTo

GotIt

If InStr(1, Criteria2, ">=", vbTextCompare) > 0 Then sz = ">=":GoTo

GotIt

If InStr(1, Criteria2, "<>", vbTextCompare) > 0 Then sz = "<>": GoTo

GotIt

'If we got here then single operator used

If InStr(1, Criteria2, "<", vbTextCompare) > 0 Then sz = "<": GoTo

GotIt

If InStr(1, Criteria2, ">", vbTextCompare) > 0 Then sz = ">": GoTo

GotIt

If InStr(1, Criteria2, "=", vbTextCompare) > 0 Then sz = "=": GoTo

GotIt

GotIt:

v2 = CDbl(Mid(Criteria2, Len(sz) + 1))

For Each c In Criteria1Range

If c.Value = Criteria1 Then

v1 = Cells(Criteria2Range.Row, c.Column).Value

Select Case sz

'Check combined operators first

Case "<=": If v1 <= v2 Then dValues = dValues + v1:iCount =

iCount + 1

Case ">=": If v1 >= v2 Then dValues = dValues + v1:iCount =

iCount + 1

Case "<>": If v1 <> v2 Then dValues = dValues + v1: iCount =

iCount + 1

'If we got here then single operator used

Case "<": If v1 < v2 Then dValues = dValues + v1: iCount =

iCount + 1

Case ">": If v1 > v2 Then dValues = dValues + v1: iCount =

iCount + 1

Case "=": If v1 = v2 Then dValues = dValues + v1: iCount =

iCount + 1

End Select

End If

Next

Average_2Ifs = (dValues / iCount)

End Function 'Average_2Ifs()

Example usage:

Formula to put in the target cell:

=average_2ifs($F$5:$HB$5,$F$1:$HB$1,"SCORE",$F$5:$HB$5,">0")

**Assumes each 'SCORE' column is labeled "SCORE" in Row1.

I'm also working on a worksheet formula solution which I'll post later.

--

Garry

Free usenet access athttp://

www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc