Weighted average UDF... a bit more complex

[Charles]

Hello

I know the question has already been asked. But I am looking for
something specific. I would like to create a weighted average function,
but that would work (also) with array formula, i.e. I would like to be
able to do that:

EXCEL:
A B C
1 100 Blue 50
2 100 Green 20
3 100 Blue 10

{=WA(A1:A3,C1:C3*(B1:B3="Blue"))}
that would calculate the weighted average of the column A, weighted by
the column C, but only taking into consideration the items with a
column B = "Blue".

I am less interested in the way to create the weighted average function
itself than the syntax to create a user defined forumla that is able to
handle array arguments and return an array.

Thanks for your help
Charles

 

[Tom Ogilvy]

Public Function WA(v As Range, d As Variant)
Dim dsum As Double, dwt As Double
For i = LBound(d, 1) To UBound(d, 1)
dsum = dsum + v(i, 1) * d(i, 1)
dwt = dwt + d(i, 1)
Next
If dwt <> 0 Then
WA = dsum / dwt
Else
WA = CVErr(xlErrDiv0)
End If

End Function

 

[Bob Phillips]

=IF(B1:B3="Blue",C1:C3)

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Charles]

Thanks Tom, that appears to work perfectly with my example, but I loose
the ability to use it as a simple weighted average function, i.e.
=WA(A1:A3,C1:C3)

Do you think there is a way to keep the function "array friendly" while
still being "range friendly", a bit like the "SUM" function which you
can use both with a simple range or an rray calculations as argument.
Or is it beyond the limit of VBA UDF?

Thanks
Charles

 

[Charles]

And thinking about it, what would be the top of the top is if you can
use an array function or a range in any of the argument of the
function, i.e.

{=WA(IF(Z1:Z100="Blue",D1100,E1:E100),C1:C100)}

which would allow to substitute a value to another within the first
argument based on wether the column Z says Blue or not.

starts to look like a kid's christmas list. I am mostly curious about a
syntax that would accomodate everything

Thanks
Charles

 

[Charles]

I actually found a solution thanks to an earlier post:

Public Function WA(v As Variant, d As Variant) As Double
Dim dsum As Double, dwt As Double
If TypeOf v Is Excel.Range Then
v = v.Value2
End If
If TypeOf d Is Excel.Range Then
d = d.Value2
End If
For i = LBound(d, 1) To UBound(d, 1)
dsum = dsum + v(i, 1) * d(i, 1)
dwt = dwt + d(i, 1)
Next
If dwt <> 0 Then
WA = dsum / dwt
Else
WA = CVErr(xlErrDiv0)
End If
End Function

Thanks for your help!

 

[Harlan Grove]

Charles wrote...

I actually found a solution thanks to an earlier post:

Public Function WA(v As Variant, d As Variant) As Double ....
For i = LBound(d, 1) To UBound(d, 1)
dsum = dsum + v(i, 1) * d(i, 1)
dwt = dwt + d(i, 1)
Next
If dwt <> 0 Then
WA = dsum / dwt
Else
WA = CVErr(xlErrDiv0)
End If

You don't include a check that v and d have the same number of items or
(more restrictive) are shaped the same. Since you don't check this,
your udf would return #VALUE! due to runtime errors whenever there are
fewer items in v than in d. Also, since you're the one who wants to
handle arrays as well as ranges, not all arrays are 2D, so the
assignment statements above would also throw runtime errors when v
and/or d is 1D. Finally, you can't return #DIV/0! unless the function's
return type is Variant. The CVErr assignment will also throw runtime
errors, thus returning #VALUE! rather than #DIV/0!.

Then there's the semantic issue that your udf accepts negative weights.

The safe way to do this would be something like

Function wa(v As Variant, w As Variant) As Double
Dim aw() As Double, t As Double, x As Variant
Dim sv As Double, sw As Double
Dim nv As Long, nw As Long

'make sure v and w aren't scalars
If Not IsArray(v) Then v = Array(v)
If Not IsArray(w) Then w = Array(w)

nw = 16 'positive initial value - modify as needed
ReDim aw(1 To nw)

nv = 0 'first using nv to count items in w
For Each x In w
nv = nv + 1
If nv >= nw Then
nw = 2 * nw
ReDim Preserve aw(1 To nw)
End If
aw(nv) = x
Next x

nw = nv
ReDim Preserve aw(1 To nw)
nv = 0 'now using nv to count items in v

For Each x In v
nv = nv + 1
t = aw(nv)
If t > 0 Then
sv = sv + x * t
sw = sw + t
End If
Next x

If nv = nw And sw > 0 Then
wa = sv / sw
ElseIf nv <> nw Then
wa = CVErr(xlErrNA)
Else
wa = CVErr(xlErrDiv0)
End If

End Function


When you need to process multiple array arguments, you should check
that they have the same number of items at least. Checking whether
they're the same shape is trickier, but sometimes that's necessary.