I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

'If a percentage is higher than 1, only 100% is counted
in the formula.
'It is already applied to A, B, C and D locally in excel.


'There are 16 possible combinations of A, B, C & D
(2*2*2*2)
'Each case is examined below. 1 notes not null. 0 notates
null.

'1111 - CASE 1
If A 0 And B 0 And C 0 And D 0 Then
WeightedAvg = ValueA * A + ValueB * B + ValueC * C +
ValueD * D
'0111 - CASE 2
ElseIf A = 0 And B 0 And C 0 And D 0 Then
Total = ValueB + ValueC + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueC / Total)
* C + (ValueD / Total) * D
'0011 - CASE 3
ElseIf A = 0 And B = 0 And C 0 And D 0 Then
Total = ValueC + ValueD
WeightedAvg = (ValueC / Total) * C + (ValueD / Total)
* D
'0001 - CASE 4
ElseIf A = 0 And B = 0 And C = 0 And D 0 Then
Total = ValueD
WeightedAvg = (ValueD / Total) * D
'0101 - CASE 5
ElseIf A = 0 And B 0 And C = 0 And D 0 Then
Total = ValueB + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueD / Total)
* D
'0100 - CASE 6
ElseIf A = 0 And B 0 And C = 0 And D = 0 Then
Total = ValueB
WeightedAvg = (ValueB / Total) * B
'0010 - CASE 7
ElseIf A = 0 And B = 0 And C 0 And D = 0 Then
Total = ValueC
WeightedAvg = (ValueC / Total) * C
'0000 - CASE 8
ElseIf A = 0 And B = 0 And C = 0 And D = 0 Then
WeightedAvg = 0
'1000 - CASE 9
ElseIf A 0 And B = 0 And C = 0 And D = 0 Then
Total = ValueA
WeightedAvg = (ValueA / Total) * A
'1100 - CASE 10
ElseIf A 0 And B 0 And C = 0 And D = 0 Then
Total = ValueA + ValueB
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B
'1110 - CASE 11
ElseIf A 0 And B 0 And C 0 And D = 0 Then
Total = ValueA + ValueB + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B + (ValueC / Total) * C
'1010 - CASE 12
ElseIf A 0 And B = 0 And C 0 And D = 0 Then
Total = ValueA + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueC / Total)
* C
'1011 - CASE 13
ElseIf A 0 And B = 0 And C 0 And D 0 Then
Total = ValueA + ValueC + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueC / Total)
* C + (ValueD / Total) * D
'1101 - CASE 14
ElseIf A 0 And B 0 And C = 0 And D 0 Then
Total = ValueA + ValueB + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B + (ValueD / Total) * D
'1001 - CASE 15
ElseIf A 0 And B = 0 And C = 0 And D 0 Then
Total = ValueA + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueD / Total)
* D
'0110 - CASE 16
ElseIf A = 0 And B 0 And C 0 And D = 0 Then
Total = ValueB + ValueC
WeightedAvg = (ValueB / Total) * B + (ValueC / Total)
* C
End If


End Function

You can simplify this type of calculation by using array variables. It also makes it easy to extend the calculation for more input
values or generalise it for any number of input values. The following illustrates the idea:

Sub Test()
Dim Value(1 To 4)
Dim A(1 To 4)
Dim Total As Double
Dim TotalA As Double
Dim WeightedAvg As Double
Dim i As Integer

Value(1) = 0.5
Value(2) = 0.25
Value(3) = 0.15
Value(4) = 0.1

A(1) = 10
A(2) = 0
A(3) = 5
A(4) = 30

For i = 1 To 4
TotalA = TotalA + A(i) * Value(i)
If A(i) 0 Then Total = Total + Value(i)
Next i

WeightedAvg = TotalA / Total

MsgBox WeightedAvg

End Sub


--

John Green - Excel MVP
Sydney
Australia


"Diana" wrote in message ...
I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

'If a percentage is higher than 1, only 100% is counted
in the formula.
'It is already applied to A, B, C and D locally in excel.


'There are 16 possible combinations of A, B, C & D
(2*2*2*2)
'Each case is examined below. 1 notes not null. 0 notates
null.

'1111 - CASE 1
If A 0 And B 0 And C 0 And D 0 Then
WeightedAvg = ValueA * A + ValueB * B + ValueC * C +
ValueD * D
'0111 - CASE 2
ElseIf A = 0 And B 0 And C 0 And D 0 Then
Total = ValueB + ValueC + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueC / Total)
* C + (ValueD / Total) * D
'0011 - CASE 3
ElseIf A = 0 And B = 0 And C 0 And D 0 Then
Total = ValueC + ValueD
WeightedAvg = (ValueC / Total) * C + (ValueD / Total)
* D
'0001 - CASE 4
ElseIf A = 0 And B = 0 And C = 0 And D 0 Then
Total = ValueD
WeightedAvg = (ValueD / Total) * D
'0101 - CASE 5
ElseIf A = 0 And B 0 And C = 0 And D 0 Then
Total = ValueB + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueD / Total)
* D
'0100 - CASE 6
ElseIf A = 0 And B 0 And C = 0 And D = 0 Then
Total = ValueB
WeightedAvg = (ValueB / Total) * B
'0010 - CASE 7
ElseIf A = 0 And B = 0 And C 0 And D = 0 Then
Total = ValueC
WeightedAvg = (ValueC / Total) * C
'0000 - CASE 8
ElseIf A = 0 And B = 0 And C = 0 And D = 0 Then
WeightedAvg = 0
'1000 - CASE 9
ElseIf A 0 And B = 0 And C = 0 And D = 0 Then
Total = ValueA
WeightedAvg = (ValueA / Total) * A
'1100 - CASE 10
ElseIf A 0 And B 0 And C = 0 And D = 0 Then
Total = ValueA + ValueB
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B
'1110 - CASE 11
ElseIf A 0 And B 0 And C 0 And D = 0 Then
Total = ValueA + ValueB + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B + (ValueC / Total) * C
'1010 - CASE 12
ElseIf A 0 And B = 0 And C 0 And D = 0 Then
Total = ValueA + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueC / Total)
* C
'1011 - CASE 13
ElseIf A 0 And B = 0 And C 0 And D 0 Then
Total = ValueA + ValueC + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueC / Total)
* C + (ValueD / Total) * D
'1101 - CASE 14
ElseIf A 0 And B 0 And C = 0 And D 0 Then
Total = ValueA + ValueB + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B + (ValueD / Total) * D
'1001 - CASE 15
ElseIf A 0 And B = 0 And C = 0 And D 0 Then
Total = ValueA + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueD / Total)
* D
'0110 - CASE 16
ElseIf A = 0 And B 0 And C 0 And D = 0 Then
Total = ValueB + ValueC
WeightedAvg = (ValueB / Total) * B + (ValueC / Total)
* C
End If


End Function

Maybe:


Public Function WeightedAvgNew(ParamArray dataIn())
'Created by Francisco Mariscal on 08/21/03
Dim i As Integer
Dim weightedPerc(), Total As Double, sumData As Double
'Weighted percentages by default
weightedPerc = Array(0.5, 0.25, 0.15, 0.1)
'If a percentage is higher than 1, only 100% is counted in
the formula.
Total = 0
For i = 0 To 3
If dataIn(i) 0 Then
Total = Total + weightedPerc(i)
End If
Next i
sumData = 0
For i = 0 To 3
If dataIn(i) 0 Then
sumData = sumData + (weightedPerc(i) / Total) *
dataIn(i)
End If
Next i
WeightedAvgNew = sumData
End Function





Francisco Mariscal
fcomariscal at hotmail dot com


-----Original Message-----
I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

'If a percentage is higher than 1, only 100% is counted
in the formula.
'It is already applied to A, B, C and D locally in excel.


'There are 16 possible combinations of A, B, C & D
(2*2*2*2)
'Each case is examined below. 1 notes not null. 0 notates
null.

'1111 - CASE 1
If A 0 And B 0 And C 0 And D 0 Then
WeightedAvg = ValueA * A + ValueB * B + ValueC * C +
ValueD * D
'0111 - CASE 2
ElseIf A = 0 And B 0 And C 0 And D 0 Then
Total = ValueB + ValueC + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueC / Total)
* C + (ValueD / Total) * D
'0011 - CASE 3
ElseIf A = 0 And B = 0 And C 0 And D 0 Then
Total = ValueC + ValueD
WeightedAvg = (ValueC / Total) * C + (ValueD / Total)
* D
'0001 - CASE 4
ElseIf A = 0 And B = 0 And C = 0 And D 0 Then
Total = ValueD
WeightedAvg = (ValueD / Total) * D
'0101 - CASE 5
ElseIf A = 0 And B 0 And C = 0 And D 0 Then
Total = ValueB + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueD / Total)
* D
'0100 - CASE 6
ElseIf A = 0 And B 0 And C = 0 And D = 0 Then
Total = ValueB
WeightedAvg = (ValueB / Total) * B
'0010 - CASE 7
ElseIf A = 0 And B = 0 And C 0 And D = 0 Then
Total = ValueC
WeightedAvg = (ValueC / Total) * C
'0000 - CASE 8
ElseIf A = 0 And B = 0 And C = 0 And D = 0 Then
WeightedAvg = 0
'1000 - CASE 9
ElseIf A 0 And B = 0 And C = 0 And D = 0 Then
Total = ValueA
WeightedAvg = (ValueA / Total) * A
'1100 - CASE 10
ElseIf A 0 And B 0 And C = 0 And D = 0 Then
Total = ValueA + ValueB
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B
'1110 - CASE 11
ElseIf A 0 And B 0 And C 0 And D = 0 Then
Total = ValueA + ValueB + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B + (ValueC / Total) * C
'1010 - CASE 12
ElseIf A 0 And B = 0 And C 0 And D = 0 Then
Total = ValueA + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueC / Total)
* C
'1011 - CASE 13
ElseIf A 0 And B = 0 And C 0 And D 0 Then
Total = ValueA + ValueC + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueC / Total)
* C + (ValueD / Total) * D
'1101 - CASE 14
ElseIf A 0 And B 0 And C = 0 And D 0 Then
Total = ValueA + ValueB + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B + (ValueD / Total) * D
'1001 - CASE 15
ElseIf A 0 And B = 0 And C = 0 And D 0 Then
Total = ValueA + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueD / Total)
* D
'0110 - CASE 16
ElseIf A = 0 And B 0 And C 0 And D = 0 Then
Total = ValueB + ValueC
WeightedAvg = (ValueB / Total) * B + (ValueC / Total)
* C
End If


End Function

.

Try this, Diana. Let me know if you have problems. I tested it against
yours and got the same answers every time.

Mark

Public Function WeightedAvg(A, B, C, D)

Dim ValueA, ValueB, ValueC, ValueD, Total As Double
Dim Vals(3) As Double
Dim Per(3) As Double
Dim Sums(3) As Double

On Error GoTo Handle

Vals(0) = A
Vals(1) = B
Vals(2) = C
Vals(3) = D

Per(0) = 0.5
Per(1) = 0.25
Per(2) = 0.15
Per(3) = 0.1

IsTot = False

For x = 0 To 3
If Vals(x) = 0 Then
IsTot = True
End If
Sums(x) = Vals(x) * Per(x)
Next x

y = 0
If IsTot = True Then
For x = 0 To 3
If Sums(x) < 0 Then
y = y + Per(x)
End If
Next x
For x = 0 To 3
Sums(x) = Sums(x) / y
Next x
End If

Total = 0
For x = 0 To 3
Total = Total + Sums(x)
Next x

WeightedAvg = Total

Handle:
WeightedAvg = 0

End Function

---
Mark Bigelow
mjbigelow at hotmail dot com
http://hm.imperialoiltx.com

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Diana,

let me add my version too... please!!!



Public Function WeightedAvg#(Optional A, Optional B, _
Optional C, Optional D)

'Created by Diana Popovska on 08/21/03
'edited by keepITcool :)
Dim Weights, Values, noNull%(0 To 3), i%

Weights = Array(0.5, 0.25, 0.15, 0.1)
Values = Array(A, B, C, D)
For i = 0 To 3
If IsError(Values(i)) Then
noNull(i) = 0
Values(i) = 0
Else
noNull(i) = 1
End If
Next

With Application.WorksheetFunction
WeightedAvg = .SumProduct(Weights, Values) / _
.SumProduct(Weights, noNull)
End With
End Function





keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Diana" wrote:

I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
<SNAP

You received some very good responses that contained very good code that
(at least at a glance) appeared to be good code that you'd be very happy
with. I did think of a couple of aspects that I did not hear addressed
in earlier replies:

When I first looked at this I saw not 16 but 81 possible combinations.
If you haven't already ruled it to be impossible, you should consider if
any circumstances might produce a negative number in any of the 4
elements. (For example you might simply change each "" to "<"). I
know that it doesn't fulfill your subject "more efficient" but it may be
something that you need to program for.

You also speak of "null" when I sense you may really be referring to
"zero" (the value 0). Just be aware that in Excel, and Excel's VBA
code, those two words are significantly different. (Not that it
invalidates what you already have now).

Finally, some smartly coded replies were given to you that were more
versatile, more reusable, more concise, etc. as opposed to simply
"running faster" (which is just my initial impression of what efficiency
refers to). When you say "more efficient" did you mean in terms of
reducing redundant or unnecessarily repeated code, or faster running?

'There are 16 possible combinations of A, B, C & D
(2*2*2*2)
'Each case is examined below. 1 notes not null. 0 notates
null.

'1111 - CASE 1
If A 0 And B 0 And C 0 And D 0 Then
WeightedAvg = ValueA * A + ValueB * B + ValueC * C +
ValueD * D
'0111 - CASE 2
ElseIf A = 0 And B 0 And C 0 And D 0 Then
...
...

I most likely have done this wrong, but this article suggest the following
formula...

Calculating Weighted Averages
http://support.microsoft.com/default...b;en-us;109211

Sub Test()
Dim Wgt(1 To 4)
Dim n(1 To 4)
Dim WeightedAvg As Double

Wgt(1) = 0.5
Wgt(2) = 0.25
Wgt(3) = 0.15
Wgt(4) = 0.1

n(1) = 10
n(2) = 0
n(3) = 5
n(4) = 30


With WorksheetFunction
WeightedAvg = .SumProduct(n, Wgt) / .Sum(n)
End With

MsgBox WeightedAvg
End Sub

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


"Diana" wrote in message
...
I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

'If a percentage is higher than 1, only 100% is counted
in the formula.
'It is already applied to A, B, C and D locally in excel.


'There are 16 possible combinations of A, B, C & D
(2*2*2*2)
'Each case is examined below. 1 notes not null. 0 notates
null.

'1111 - CASE 1
If A 0 And B 0 And C 0 And D 0 Then
WeightedAvg = ValueA * A + ValueB * B + ValueC * C +
ValueD * D
'0111 - CASE 2
ElseIf A = 0 And B 0 And C 0 And D 0 Then
Total = ValueB + ValueC + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueC / Total)
* C + (ValueD / Total) * D
'0011 - CASE 3
ElseIf A = 0 And B = 0 And C 0 And D 0 Then
Total = ValueC + ValueD
WeightedAvg = (ValueC / Total) * C + (ValueD / Total)
* D
'0001 - CASE 4
ElseIf A = 0 And B = 0 And C = 0 And D 0 Then
Total = ValueD
WeightedAvg = (ValueD / Total) * D
'0101 - CASE 5
ElseIf A = 0 And B 0 And C = 0 And D 0 Then
Total = ValueB + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueD / Total)
* D
'0100 - CASE 6
ElseIf A = 0 And B 0 And C = 0 And D = 0 Then
Total = ValueB
WeightedAvg = (ValueB / Total) * B
'0010 - CASE 7
ElseIf A = 0 And B = 0 And C 0 And D = 0 Then
Total = ValueC
WeightedAvg = (ValueC / Total) * C
'0000 - CASE 8
ElseIf A = 0 And B = 0 And C = 0 And D = 0 Then
WeightedAvg = 0
'1000 - CASE 9
ElseIf A 0 And B = 0 And C = 0 And D = 0 Then
Total = ValueA
WeightedAvg = (ValueA / Total) * A
'1100 - CASE 10
ElseIf A 0 And B 0 And C = 0 And D = 0 Then
Total = ValueA + ValueB
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B
'1110 - CASE 11
ElseIf A 0 And B 0 And C 0 And D = 0 Then
Total = ValueA + ValueB + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B + (ValueC / Total) * C
'1010 - CASE 12
ElseIf A 0 And B = 0 And C 0 And D = 0 Then
Total = ValueA + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueC / Total)
* C
'1011 - CASE 13
ElseIf A 0 And B = 0 And C 0 And D 0 Then
Total = ValueA + ValueC + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueC / Total)
* C + (ValueD / Total) * D
'1101 - CASE 14
ElseIf A 0 And B 0 And C = 0 And D 0 Then
Total = ValueA + ValueB + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueB / Total)
* B + (ValueD / Total) * D
'1001 - CASE 15
ElseIf A 0 And B = 0 And C = 0 And D 0 Then
Total = ValueA + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueD / Total)
* D
'0110 - CASE 16
ElseIf A = 0 And B 0 And C 0 And D = 0 Then
Total = ValueB + ValueC
WeightedAvg = (ValueB / Total) * B + (ValueC / Total)
* C
End If


End Function

Dana

this would work except OP wants to correct
for missing values..e.g. incomplete n series
hence my variation (see earlier post.)

With Application.WorksheetFunction
WeightedAvg = .SumProduct(Weights, Values) / _
.SumProduct(Weights, noNull)
End With


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Dana DeLouis" wrote:

I most likely have done this wrong, but this article suggest the
following formula...

Calculating Weighted Averages
http://support.microsoft.com/default...b;en-us;109211

Sub Test()
Dim Wgt(1 To 4)
Dim n(1 To 4)
Dim WeightedAvg As Double

Wgt(1) = 0.5
Wgt(2) = 0.25
Wgt(3) = 0.15
Wgt(4) = 0.1

n(1) = 10
n(2) = 0
n(3) = 5
n(4) = 30


With WorksheetFunction
WeightedAvg = .SumProduct(n, Wgt) / .Sum(n)
End With

MsgBox WeightedAvg
End Sub

Hi

Your function doesn't return the same value as Diana's
function, when A, B, C or D is zero, and if A, B, C and D
are cell references, your formula returns an error, if one or
more of the cells is empty!?

--
Best Regards
Leo Heuser
MVP Excel

Followup to newsgroup only please.

"keepitcool" skrev i en meddelelse
...
Diana,

let me add my version too... please!!!



Public Function WeightedAvg#(Optional A, Optional B, _
Optional C, Optional D)

'Created by Diana Popovska on 08/21/03
'edited by keepITcool :)
Dim Weights, Values, noNull%(0 To 3), i%

Weights = Array(0.5, 0.25, 0.15, 0.1)
Values = Array(A, B, C, D)
For i = 0 To 3
If IsError(Values(i)) Then
noNull(i) = 0
Values(i) = 0
Else
noNull(i) = 1
End If
Next

With Application.WorksheetFunction
WeightedAvg = .SumProduct(Weights, Values) / _
.SumProduct(Weights, noNull)
End With
End Function





keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Diana" wrote:

I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
<SNAP

Good morning!


Nothing like a good night's sleep!

Here's another option, which works for all
numbers, positive, negative, zero and empty cells.
For more than 4 weights, just add to Array(0.5, 0.25, 0.15, 0.1)

Function Wa(ParamArray A() As Variant)
'Leo Heuser, 22 Aug. 2003
Dim Counter As Long
Dim Total As Double
Dim WeightPercent As Variant

'Weighted percentages by default
WeightPercent = Array(0.5, 0.25, 0.15, 0.1)

For Counter = LBound(A) To UBound(A)
Total = Total + WeightPercent(Counter) * (A(Counter) < 0)
Next Counter

For Counter = LBound(A) To UBound(A)
Wa = Wa + WeightPercent(Counter) / Total * _
A(Counter) * (A(Counter) < 0)
Next Counter

End Function

If the values are in a contiguous range and the weights are
in a contiguous range, it's not necessary to use a UDF.

This formula will do the job, assuming values in B23:B26
and weights in A23:A26. Works for all numbers and empty cells.

=SUMPRODUCT(B23:B26*A23:A26/SUMPRODUCT((B23:B26<0)*A23:A26))

--
Best Regards
Leo Heuser
MVP Excel

Followup to newsgroup only please.

"Leo Heuser" skrev i en meddelelse
...
Diana

How about this cut-down version :-)

The function can easily be changed to cover more
than 4 values. It's just a matter of adding lines.

Assuming, as does your example, that only positive
numbers and/or 0 are used.

Function WeightedAvg(A As Double, B As Double, C As Double, D As Double)
'Leo Heuser, 22 Aug. 2003
Dim ValueA As Double
Dim ValueB As Double
Dim ValueC As Double
Dim ValueD As Double
Dim Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

Total = _
ValueA * (A 0) + _
ValueB * (B 0) + _
ValueC * (C 0) + _
ValueD * (D 0)

WeightedAvg = _
ValueA / Total * A * (A 0) + _
ValueB / Total * B * (B 0) + _
ValueC / Total * C * (C 0) + _
ValueD / Total * D * (D 0)

End Function


In the line

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

only Total is dimensioned as a double. The other variables
are dimensioned as Variant. In order to have all dimensioned
as Doubles, you have to put them on separate lines as shown
in my function or declare each one explicitly:

Dim ValueA As Double, ValueB As Double, ValueC As Double, ValueD As
Double,
Total As Double

--
Best Regards
Leo Heuser
MVP Excel

Followup to newsgroup only please.

I am so excited to see your responses today, and I can't
wait to check out the formulas this weekend. Thank you.
You guys rock. I hope your intelligence rubs off on my
future formula writing...

-----Original Message-----
I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

'If a percentage is higher than 1, only 100% is counted
in the formula.
'It is already applied to A, B, C and D locally in excel.


'There are 16 possible combinations of A, B, C & D
(2*2*2*2)
'Each case is examined below. 1 notes not null. 0
notates
null.

'1111 - CASE 1
If A 0 And B 0 And C 0 And D 0 Then
WeightedAvg = ValueA * A + ValueB * B + ValueC * C +
ValueD * D
'0111 - CASE 2
ElseIf A = 0 And B 0 And C 0 And D 0 Then
Total = ValueB + ValueC + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueC /
Total)
* C + (ValueD / Total) * D
'0011 - CASE 3
ElseIf A = 0 And B = 0 And C 0 And D 0 Then
Total = ValueC + ValueD
WeightedAvg = (ValueC / Total) * C + (ValueD /
Total)
* D
'0001 - CASE 4
ElseIf A = 0 And B = 0 And C = 0 And D 0 Then
Total = ValueD
WeightedAvg = (ValueD / Total) * D
'0101 - CASE 5
ElseIf A = 0 And B 0 And C = 0 And D 0 Then
Total = ValueB + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueD /
Total)
* D
'0100 - CASE 6
ElseIf A = 0 And B 0 And C = 0 And D = 0 Then
Total = ValueB
WeightedAvg = (ValueB / Total) * B
'0010 - CASE 7
ElseIf A = 0 And B = 0 And C 0 And D = 0 Then
Total = ValueC
WeightedAvg = (ValueC / Total) * C
'0000 - CASE 8
ElseIf A = 0 And B = 0 And C = 0 And D = 0 Then
WeightedAvg = 0
'1000 - CASE 9
ElseIf A 0 And B = 0 And C = 0 And D = 0 Then
Total = ValueA
WeightedAvg = (ValueA / Total) * A
'1100 - CASE 10
ElseIf A 0 And B 0 And C = 0 And D = 0 Then
Total = ValueA + ValueB
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B
'1110 - CASE 11
ElseIf A 0 And B 0 And C 0 And D = 0 Then
Total = ValueA + ValueB + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B + (ValueC / Total) * C
'1010 - CASE 12
ElseIf A 0 And B = 0 And C 0 And D = 0 Then
Total = ValueA + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueC /
Total)
* C
'1011 - CASE 13
ElseIf A 0 And B = 0 And C 0 And D 0 Then
Total = ValueA + ValueC + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueC /
Total)
* C + (ValueD / Total) * D
'1101 - CASE 14
ElseIf A 0 And B 0 And C = 0 And D 0 Then
Total = ValueA + ValueB + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B + (ValueD / Total) * D
'1001 - CASE 15
ElseIf A 0 And B = 0 And C = 0 And D 0 Then
Total = ValueA + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueD /
Total)
* D
'0110 - CASE 16
ElseIf A = 0 And B 0 And C 0 And D = 0 Then
Total = ValueB + ValueC
WeightedAvg = (ValueB / Total) * B + (ValueC /
Total)
* C
End If


End Function

.

This is a smart way of thinking but when I cut and paste
the formula I get zero no matter what A,B,C and D is...

-----Original Message-----
Try this, Diana. Let me know if you have problems. I
tested it against
yours and got the same answers every time.

Mark

Public Function WeightedAvg(A, B, C, D)

Dim ValueA, ValueB, ValueC, ValueD, Total As Double
Dim Vals(3) As Double
Dim Per(3) As Double
Dim Sums(3) As Double

On Error GoTo Handle

Vals(0) = A
Vals(1) = B
Vals(2) = C
Vals(3) = D

Per(0) = 0.5
Per(1) = 0.25
Per(2) = 0.15
Per(3) = 0.1

IsTot = False

For x = 0 To 3
If Vals(x) = 0 Then
IsTot = True
End If
Sums(x) = Vals(x) * Per(x)
Next x

y = 0
If IsTot = True Then
For x = 0 To 3
If Sums(x) < 0 Then
y = y + Per(x)
End If
Next x
For x = 0 To 3
Sums(x) = Sums(x) / y
Next x
End If

Total = 0
For x = 0 To 3
Total = Total + Sums(x)
Next x

WeightedAvg = Total

Handle:
WeightedAvg = 0

End Function

---
Mark Bigelow
mjbigelow at hotmail dot com
http://hm.imperialoiltx.com

*** Sent via Developersdex http://www.developersdex.com
***
Don't just participate in USENET...get rewarded for it!
.

This works great and it is probably 10 percent of the
length of mine. Thanks. I hope my future formula writing
endeavors will improve. It looks like I am trying to
solve a math problem as opposed to thinking in the realms
of what vb could offer...

-----Original Message-----
You can simplify this type of calculation by using array
variables. It also makes it easy to extend the
calculation for more input
values or generalise it for any number of input values.
The following illustrates the idea:

Sub Test()
Dim Value(1 To 4)
Dim A(1 To 4)
Dim Total As Double
Dim TotalA As Double
Dim WeightedAvg As Double
Dim i As Integer

Value(1) = 0.5
Value(2) = 0.25
Value(3) = 0.15
Value(4) = 0.1

A(1) = 10
A(2) = 0
A(3) = 5
A(4) = 30

For i = 1 To 4
TotalA = TotalA + A(i) * Value(i)
If A(i) 0 Then Total = Total + Value(i)
Next i

WeightedAvg = TotalA / Total

MsgBox WeightedAvg

End Sub


--

John Green - Excel MVP
Sydney
Australia


"Diana" wrote in message
...
I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

'If a percentage is higher than 1, only 100% is counted
in the formula.
'It is already applied to A, B, C and D locally in
excel.


'There are 16 possible combinations of A, B, C & D
(2*2*2*2)
'Each case is examined below. 1 notes not null. 0
notates
null.

'1111 - CASE 1
If A 0 And B 0 And C 0 And D 0 Then
WeightedAvg = ValueA * A + ValueB * B + ValueC * C
+
ValueD * D
'0111 - CASE 2
ElseIf A = 0 And B 0 And C 0 And D 0 Then
Total = ValueB + ValueC + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueC /
Total)
* C + (ValueD / Total) * D
'0011 - CASE 3
ElseIf A = 0 And B = 0 And C 0 And D 0 Then
Total = ValueC + ValueD
WeightedAvg = (ValueC / Total) * C + (ValueD /
Total)
* D
'0001 - CASE 4
ElseIf A = 0 And B = 0 And C = 0 And D 0 Then
Total = ValueD
WeightedAvg = (ValueD / Total) * D
'0101 - CASE 5
ElseIf A = 0 And B 0 And C = 0 And D 0 Then
Total = ValueB + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueD /
Total)
* D
'0100 - CASE 6
ElseIf A = 0 And B 0 And C = 0 And D = 0 Then
Total = ValueB
WeightedAvg = (ValueB / Total) * B
'0010 - CASE 7
ElseIf A = 0 And B = 0 And C 0 And D = 0 Then
Total = ValueC
WeightedAvg = (ValueC / Total) * C
'0000 - CASE 8
ElseIf A = 0 And B = 0 And C = 0 And D = 0 Then
WeightedAvg = 0
'1000 - CASE 9
ElseIf A 0 And B = 0 And C = 0 And D = 0 Then
Total = ValueA
WeightedAvg = (ValueA / Total) * A
'1100 - CASE 10
ElseIf A 0 And B 0 And C = 0 And D = 0 Then
Total = ValueA + ValueB
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B
'1110 - CASE 11
ElseIf A 0 And B 0 And C 0 And D = 0 Then
Total = ValueA + ValueB + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B + (ValueC / Total) * C
'1010 - CASE 12
ElseIf A 0 And B = 0 And C 0 And D = 0 Then
Total = ValueA + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueC /
Total)
* C
'1011 - CASE 13
ElseIf A 0 And B = 0 And C 0 And D 0 Then
Total = ValueA + ValueC + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueC /
Total)
* C + (ValueD / Total) * D
'1101 - CASE 14
ElseIf A 0 And B 0 And C = 0 And D 0 Then
Total = ValueA + ValueB + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B + (ValueD / Total) * D
'1001 - CASE 15
ElseIf A 0 And B = 0 And C = 0 And D 0 Then
Total = ValueA + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueD /
Total)
* D
'0110 - CASE 16
ElseIf A = 0 And B 0 And C 0 And D = 0 Then
Total = ValueB + ValueC
WeightedAvg = (ValueB / Total) * B + (ValueC /
Total)
* C
End If


End Function



.

Hi Pancho,

This is a totally different approach and I am eager to
test it. I assume the A, B, C and D are the values I
ought to plug in the ParamArray dataIn(). When I do this
I get VALUE#.

-----Original Message-----
Maybe:


Public Function WeightedAvgNew(ParamArray dataIn())
'Created by Francisco Mariscal on 08/21/03
Dim i As Integer
Dim weightedPerc(), Total As Double, sumData As Double
'Weighted percentages by default
weightedPerc = Array(0.5, 0.25, 0.15, 0.1)
'If a percentage is higher than 1, only 100% is counted
in
the formula.
Total = 0
For i = 0 To 3
If dataIn(i) 0 Then
Total = Total + weightedPerc(i)
End If
Next i
sumData = 0
For i = 0 To 3
If dataIn(i) 0 Then
sumData = sumData + (weightedPerc(i) / Total) *
dataIn(i)
End If
Next i
WeightedAvgNew = sumData
End Function





Francisco Mariscal
fcomariscal at hotmail dot com


-----Original Message-----
I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

'If a percentage is higher than 1, only 100% is counted
in the formula.
'It is already applied to A, B, C and D locally in
excel.


'There are 16 possible combinations of A, B, C & D
(2*2*2*2)
'Each case is examined below. 1 notes not null. 0
notates
null.

'1111 - CASE 1
If A 0 And B 0 And C 0 And D 0 Then
WeightedAvg = ValueA * A + ValueB * B + ValueC * C
+
ValueD * D
'0111 - CASE 2
ElseIf A = 0 And B 0 And C 0 And D 0 Then
Total = ValueB + ValueC + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueC /
Total)
* C + (ValueD / Total) * D
'0011 - CASE 3
ElseIf A = 0 And B = 0 And C 0 And D 0 Then
Total = ValueC + ValueD
WeightedAvg = (ValueC / Total) * C + (ValueD /
Total)
* D
'0001 - CASE 4
ElseIf A = 0 And B = 0 And C = 0 And D 0 Then
Total = ValueD
WeightedAvg = (ValueD / Total) * D
'0101 - CASE 5
ElseIf A = 0 And B 0 And C = 0 And D 0 Then
Total = ValueB + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueD /
Total)
* D
'0100 - CASE 6
ElseIf A = 0 And B 0 And C = 0 And D = 0 Then
Total = ValueB
WeightedAvg = (ValueB / Total) * B
'0010 - CASE 7
ElseIf A = 0 And B = 0 And C 0 And D = 0 Then
Total = ValueC
WeightedAvg = (ValueC / Total) * C
'0000 - CASE 8
ElseIf A = 0 And B = 0 And C = 0 And D = 0 Then
WeightedAvg = 0
'1000 - CASE 9
ElseIf A 0 And B = 0 And C = 0 And D = 0 Then
Total = ValueA
WeightedAvg = (ValueA / Total) * A
'1100 - CASE 10
ElseIf A 0 And B 0 And C = 0 And D = 0 Then
Total = ValueA + ValueB
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B
'1110 - CASE 11
ElseIf A 0 And B 0 And C 0 And D = 0 Then
Total = ValueA + ValueB + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B + (ValueC / Total) * C
'1010 - CASE 12
ElseIf A 0 And B = 0 And C 0 And D = 0 Then
Total = ValueA + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueC /
Total)
* C
'1011 - CASE 13
ElseIf A 0 And B = 0 And C 0 And D 0 Then
Total = ValueA + ValueC + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueC /
Total)
* C + (ValueD / Total) * D
'1101 - CASE 14
ElseIf A 0 And B 0 And C = 0 And D 0 Then
Total = ValueA + ValueB + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B + (ValueD / Total) * D
'1001 - CASE 15
ElseIf A 0 And B = 0 And C = 0 And D 0 Then
Total = ValueA + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueD /
Total)
* D
'0110 - CASE 16
ElseIf A = 0 And B 0 And C 0 And D = 0 Then
Total = ValueB + ValueC
WeightedAvg = (ValueB / Total) * B + (ValueC /
Total)
* C
End If


End Function

.

.

Thanks for your response. Please, note comments below.

When I first looked at this I saw not 16 but 81 possible
combinations. If you haven't already ruled it to be
impossible, you should consider if
any circumstances might produce a negative number in any
of the 4
elements. (For example you might simply change each ""
to "<"). I
know that it doesn't fulfill your subject "more
efficient" but it may be
something that you need to program for.

This is an excellent point! However A, B, C and D are
preprogrammed in excel and they can never be negative.

You also speak of "null" when I sense you may really be
referring to
"zero" (the value 0).

Yes, you are totally right. I understand the difference
very well and it is a sheer mistake (note to self: do not
code while being hungover). Especially because A, B, C
and D can never be null, they are set to zero if no data
is available.

When you say "more efficient" did you mean in terms of
reducing redundant or unnecessarily repeated code, or
faster running?

Actually, when I plug in my formula I get instant
results. So it is not an issue of time. I was more
interested in seeing a different logic and methods. My
thinking reflects the attempts of soving a problem using
math and statistics primarily as opposed to using the
full on power of the vb goodness as the examples have
demonstrated.

Thanks for the suggestion but it still doesn't change the
result.... This is the formula (with the same logic) that
works:

Sub Test()
Dim Value(1 To 4)
Dim A(1 To 4)
Dim Total As Double
Dim TotalA As Double
Dim WeightedAvg As Double
Dim i As Integer

Value(1) = 0.5
Value(2) = 0.25
Value(3) = 0.15
Value(4) = 0.1


A(1) = 0.5
A(2) = 0.3
A(3) = 0
A(4) = 0.1

For i = 1 To 4
TotalA = TotalA + A(i) * Value(i)
If A(i) 0 Then Total = Total + Value(i)
Next i

WeightedAvg = TotalA / Total

MsgBox WeightedAvg

End Sub

-----Original Message-----
Dana

this would work except OP wants to correct
for missing values..e.g. incomplete n series
hence my variation (see earlier post.)

With Application.WorksheetFunction
WeightedAvg = .SumProduct(Weights, Values) / _
.SumProduct(Weights, noNull)
End With


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Dana DeLouis" wrote:

I most likely have done this wrong, but this article
suggest the
following formula...

Calculating Weighted Averages
http://support.microsoft.com/default.aspx?scid=kb;en-
us;109211

Sub Test()
Dim Wgt(1 To 4)
Dim n(1 To 4)
Dim WeightedAvg As Double

Wgt(1) = 0.5
Wgt(2) = 0.25
Wgt(3) = 0.15
Wgt(4) = 0.1

n(1) = 10
n(2) = 0
n(3) = 5
n(4) = 30


With WorksheetFunction
WeightedAvg = .SumProduct(n, Wgt) / .Sum(n)
End With

MsgBox WeightedAvg
End Sub


.

Nii-ce! Thanks alot.

-----Original Message-----
Diana

How about this cut-down version :-)

The function can easily be changed to cover more
than 4 values. It's just a matter of adding lines.

Assuming, as does your example, that only positive
numbers and/or 0 are used.

Function WeightedAvg(A As Double, B As Double, C As
Double, D As Double)
'Leo Heuser, 22 Aug. 2003
Dim ValueA As Double
Dim ValueB As Double
Dim ValueC As Double
Dim ValueD As Double
Dim Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

Total = _
ValueA * (A 0) + _
ValueB * (B 0) + _
ValueC * (C 0) + _
ValueD * (D 0)

WeightedAvg = _
ValueA / Total * A * (A 0) + _
ValueB / Total * B * (B 0) + _
ValueC / Total * C * (C 0) + _
ValueD / Total * D * (D 0)

End Function


In the line

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

only Total is dimensioned as a double. The other
variables
are dimensioned as Variant. In order to have all
dimensioned
as Doubles, you have to put them on separate lines as
shown
in my function or declare each one explicitly:

Dim ValueA As Double, ValueB As Double, ValueC As
Double, ValueD As Double,
Total As Double

--
Best Regards
Leo Heuser
MVP Excel

Followup to newsgroup only please.

"Diana" skrev i en meddelelse
...
I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

'If a percentage is higher than 1, only 100% is counted
in the formula.
'It is already applied to A, B, C and D locally in
excel.


'There are 16 possible combinations of A, B, C & D
(2*2*2*2)
'Each case is examined below. 1 notes not null. 0
notates
null.

'1111 - CASE 1
If A 0 And B 0 And C 0 And D 0 Then
WeightedAvg = ValueA * A + ValueB * B + ValueC * C
+
ValueD * D
'0111 - CASE 2
ElseIf A = 0 And B 0 And C 0 And D 0 Then
Total = ValueB + ValueC + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueC /
Total)
* C + (ValueD / Total) * D
'0011 - CASE 3
ElseIf A = 0 And B = 0 And C 0 And D 0 Then
Total = ValueC + ValueD
WeightedAvg = (ValueC / Total) * C + (ValueD /
Total)
* D
'0001 - CASE 4
ElseIf A = 0 And B = 0 And C = 0 And D 0 Then
Total = ValueD
WeightedAvg = (ValueD / Total) * D
'0101 - CASE 5
ElseIf A = 0 And B 0 And C = 0 And D 0 Then
Total = ValueB + ValueD
WeightedAvg = (ValueB / Total) * B + (ValueD /
Total)
* D
'0100 - CASE 6
ElseIf A = 0 And B 0 And C = 0 And D = 0 Then
Total = ValueB
WeightedAvg = (ValueB / Total) * B
'0010 - CASE 7
ElseIf A = 0 And B = 0 And C 0 And D = 0 Then
Total = ValueC
WeightedAvg = (ValueC / Total) * C
'0000 - CASE 8
ElseIf A = 0 And B = 0 And C = 0 And D = 0 Then
WeightedAvg = 0
'1000 - CASE 9
ElseIf A 0 And B = 0 And C = 0 And D = 0 Then
Total = ValueA
WeightedAvg = (ValueA / Total) * A
'1100 - CASE 10
ElseIf A 0 And B 0 And C = 0 And D = 0 Then
Total = ValueA + ValueB
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B
'1110 - CASE 11
ElseIf A 0 And B 0 And C 0 And D = 0 Then
Total = ValueA + ValueB + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B + (ValueC / Total) * C
'1010 - CASE 12
ElseIf A 0 And B = 0 And C 0 And D = 0 Then
Total = ValueA + ValueC
WeightedAvg = (ValueA / Total) * A + (ValueC /
Total)
* C
'1011 - CASE 13
ElseIf A 0 And B = 0 And C 0 And D 0 Then
Total = ValueA + ValueC + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueC /
Total)
* C + (ValueD / Total) * D
'1101 - CASE 14
ElseIf A 0 And B 0 And C = 0 And D 0 Then
Total = ValueA + ValueB + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueB /
Total)
* B + (ValueD / Total) * D
'1001 - CASE 15
ElseIf A 0 And B = 0 And C = 0 And D 0 Then
Total = ValueA + ValueD
WeightedAvg = (ValueA / Total) * A + (ValueD /
Total)
* D
'0110 - CASE 16
ElseIf A = 0 And B 0 And C 0 And D = 0 Then
Total = ValueB + ValueC
WeightedAvg = (ValueB / Total) * B + (ValueC /
Total)
* C
End If


End Function




.

Nothing like a good night's sleep!

I agree, I finally got a good night sleep too.

This formula looks great (a bit over my head at first
glance) but I probably won't need it since A, B, C and D
values will never be negative or null ( I have
preprogrammed them). I tried it but since I don't really
know how to work it ( I plugged in the a, b, c, d range
for wa()) and got a value#.

Here's another option, which works for all
numbers, positive, negative, zero and empty cells.
For more than 4 weights, just add to Array(0.5, 0.25,
0.15, 0.1)

Function Wa(ParamArray A() As Variant)
'Leo Heuser, 22 Aug. 2003
Dim Counter As Long
Dim Total As Double
Dim WeightPercent As Variant

'Weighted percentages by default
WeightPercent = Array(0.5, 0.25, 0.15, 0.1)

For Counter = LBound(A) To UBound(A)
Total = Total + WeightPercent(Counter) * (A
(Counter) < 0)
Next Counter

For Counter = LBound(A) To UBound(A)
Wa = Wa + WeightPercent(Counter) / Total * _
A(Counter) * (A(Counter) < 0)
Next Counter

End Function

If the values are in a contiguous range and the weights
are
in a contiguous range, it's not necessary to use a UDF.

This formula will do the job, assuming values in B23:B26
and weights in A23:A26. Works for all numbers and empty
cells.

=SUMPRODUCT(B23:B26*A23:A26/SUMPRODUCT((B23:B26<0)
*A23:A26))

--
Best Regards
Leo Heuser
MVP Excel

Followup to newsgroup only please.

"Leo Heuser" skrev i en
meddelelse
...
Diana

How about this cut-down version :-)

The function can easily be changed to cover more
than 4 values. It's just a matter of adding lines.

Assuming, as does your example, that only positive
numbers and/or 0 are used.

Function WeightedAvg(A As Double, B As Double, C As
Double, D As Double)
'Leo Heuser, 22 Aug. 2003
Dim ValueA As Double
Dim ValueB As Double
Dim ValueC As Double
Dim ValueD As Double
Dim Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

Total = _
ValueA * (A 0) + _
ValueB * (B 0) + _
ValueC * (C 0) + _
ValueD * (D 0)

WeightedAvg = _
ValueA / Total * A * (A 0) + _
ValueB / Total * B * (B 0) + _
ValueC / Total * C * (C 0) + _
ValueD / Total * D * (D 0)

End Function


In the line

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

only Total is dimensioned as a double. The other
variables
are dimensioned as Variant. In order to have all
dimensioned
as Doubles, you have to put them on separate lines as
shown
in my function or declare each one explicitly:

Dim ValueA As Double, ValueB As Double, ValueC As
Double, ValueD As
Double,
Total As Double

--
Best Regards
Leo Heuser
MVP Excel

Followup to newsgroup only please.




.

If all the values are non zero ones then your function
works great. I will check out what corrections you have
suggested in your next post. Thanks.

-----Original Message-----
Diana,

let me add my version too... please!!!



Public Function WeightedAvg#(Optional A, Optional B, _
Optional C, Optional D)

'Created by Diana Popovska on 08/21/03
'edited by keepITcool :)
Dim Weights, Values, noNull%(0 To 3), i%

Weights = Array(0.5, 0.25, 0.15, 0.1)
Values = Array(A, B, C, D)
For i = 0 To 3
If IsError(Values(i)) Then
noNull(i) = 0
Values(i) = 0
Else
noNull(i) = 1
End If
Next

With Application.WorksheetFunction
WeightedAvg = .SumProduct(Weights, Values) / _
.SumProduct(Weights, noNull)
End With
End Function





keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Diana" wrote:

I just wrote the formula below and it computes the
weighted average of 4 values. If one or more values is
null the % weight is proportionately redistrubuted
over
the non null values. The weighted percentages for the
values are as follows:
A=50%
B=25%
C=15%
D=10%

Please, let me know if you could write this in a more
efficient way.

Public Function WeightedAvg(A, B, C, D)
'Created by Diana Popovska on 08/21/03

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

'Weighted percentages by default
<SNAP
.

"Diana" skrev i en meddelelse
...

Nothing like a good night's sleep!

I agree, I finally got a good night sleep too.

This formula looks great (a bit over my head at first
glance) but I probably won't need it since A, B, C and D
values will never be negative or null ( I have
preprogrammed them).


The point is, that you can use it for *all* numbers
(including positive) and empty cells.


tried it but since I don't really
know how to work it ( I plugged in the a, b, c, d range
for wa()) and got a value#.


If you use the function from the worksheet, you do it like this:
Place the function in a module.
In a cell enter:

=wa(b22,b24,b26,b28)

provided that the numbers (or empty cells) are in b22, b24, b26 and b28

Did you try the below formula in the worksheet?
It might be all you need (see explanation in my original posting below)

=SUMPRODUCT(B23:B26*A23:A26/SUMPRODUCT((B23:B26<0)*A23:A26))

Best regards
LeoH








Here's another option, which works for all
numbers, positive, negative, zero and empty cells.
For more than 4 weights, just add to Array(0.5, 0.25,
0.15, 0.1)

Function Wa(ParamArray A() As Variant)
'Leo Heuser, 22 Aug. 2003
Dim Counter As Long
Dim Total As Double
Dim WeightPercent As Variant

'Weighted percentages by default
WeightPercent = Array(0.5, 0.25, 0.15, 0.1)

For Counter = LBound(A) To UBound(A)
Total = Total + WeightPercent(Counter) * (A
(Counter) < 0)
Next Counter

For Counter = LBound(A) To UBound(A)
Wa = Wa + WeightPercent(Counter) / Total * _
A(Counter) * (A(Counter) < 0)
Next Counter

End Function

If the values are in a contiguous range and the weights
are
in a contiguous range, it's not necessary to use a UDF.

This formula will do the job, assuming values in B23:B26
and weights in A23:A26. Works for all numbers and empty
cells.

=SUMPRODUCT(B23:B26*A23:A26/SUMPRODUCT((B23:B26<0)
*A23:A26))

--
Best Regards
Leo Heuser
MVP Excel

Followup to newsgroup only please.

"Leo Heuser" skrev i en
meddelelse
...
Diana

How about this cut-down version :-)

The function can easily be changed to cover more
than 4 values. It's just a matter of adding lines.

Assuming, as does your example, that only positive
numbers and/or 0 are used.

Function WeightedAvg(A As Double, B As Double, C As
Double, D As Double)
'Leo Heuser, 22 Aug. 2003
Dim ValueA As Double
Dim ValueB As Double
Dim ValueC As Double
Dim ValueD As Double
Dim Total As Double

'Weighted percentages by default
ValueA = 0.5
ValueB = 0.25
ValueC = 0.15
ValueD = 0.1

Total = _
ValueA * (A 0) + _
ValueB * (B 0) + _
ValueC * (C 0) + _
ValueD * (D 0)

WeightedAvg = _
ValueA / Total * A * (A 0) + _
ValueB / Total * B * (B 0) + _
ValueC / Total * C * (C 0) + _
ValueD / Total * D * (D 0)

End Function


In the line

Dim ValueA, ValueB, ValueC, ValueD, Total As Double

only Total is dimensioned as a double. The other
variables
are dimensioned as Variant. In order to have all
dimensioned
as Doubles, you have to put them on separate lines as
shown
in my function or declare each one explicitly:

Dim ValueA As Double, ValueB As Double, ValueC As
Double, ValueD As
Double,
Total As Double

--
Best Regards
Leo Heuser
MVP Excel

Followup to newsgroup only please.




.