VB and VBA Users Source Code: Calculating a weighted average in Excel
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Calculating a weighted average in Excel
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, September 03, 2002
Hits:
1801
Category:
Unspecified
Article:
The following code can be use to calculate weighted averages using a filter criteria. Note, an example is included in the function comments. 'Purpose : Returns the weighted average of a range of cells based on filtering ' specified via the MatchRange and MatchCriteria properties 'Inputs : MatchRange The range containing the cells to apply the MatchCriteria filter to ' MatchCriteria The criteria to filter the cells in MatchRange with ' QuantityRange The range containing the quantities to use in the weighted average. ' ValueRange The range containing the values to use in the weighted average. 'Outputs : Returns the sum of the values in SumRange which meet the two criterias 'Author : Andrew Baker 'Date : 04/Sep/2002 'Notes : Example: ' [A] [B] [C] ' TYPE QUANTITY VALUE '[4] BREAD 100 100 '[5] BREAD 200 200 '[6] BEANS 10 10 '[7] BEANS 0 0 '[8] BREAD 0 0 ' =WEIGHTEDAVERAGE(A4:A8,"BREAD",B4:B8,C4:C8) ' (Returns 166.7) 'Revisions : Function WEIGHTEDAVERAGE(MatchRange As Excel.Range, MatchCriteria As Variant, QuantityRange As Excel.Range, ValueRange As Excel.Range) As Double Dim oCell As Excel.Range, lTotalQuantity As Long Dim fQuantity As Double, fValue As Double Application.Volatile True 'Find the matching values in the first range For Each oCell In MatchRange If oCell.Value = MatchCriteria Then 'Found a match fQuantity = QuantityRange.Parent.Cells(oCell.Row, QuantityRange.Column).Value fValue = ValueRange.Parent.Cells(oCell.Row, ValueRange.Column).Value lTotalQuantity = lTotalQuantity + fQuantity WEIGHTEDAVERAGE = WEIGHTEDAVERAGE + (fQuantity * fValue) End If Next 'Calc the weighted average If lTotalQuantity = 0 Then WEIGHTEDAVERAGE = 0 Else WEIGHTEDAVERAGE = WEIGHTEDAVERAGE / lTotalQuantity End If End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
