weighted average VBA Code

[kiran66]

Hii



i have an excel sheet and iam trying to get the weighted averages for the 4 parameters based on their date, if any one can solve my question it would help to my work. i need macros code for calculating weighted average.

upto now i did the simple average by using below code. can you modify this simple average code to weighted average code

Range("Q" & P + 7) = Round(WorksheetFunction.AverageIf(Range("A8:A" & lastRow_R), CDate(xCol2.Item(P)), Range("E8:E" & lastRow_R)), 2)

Range("R" & P + 7) = Round(WorksheetFunction.AverageIf(Range("A8:A" & lastRow_R), CDate(xCol2.Item(P)), Range("F8:F" & lastRow_R)), 2)

Range("S" & P + 7) = Round(WorksheetFunction.AverageIf(Range("A8:A" & lastRow_R), CDate(xCol2.Item(P)), Range("G8:G" & lastRow_R)), 2)

Here

A Column indicates-Date

E,F&G Column Indicates- Parameters

C Column indicates -Weight for respected item

Q,R,S Column indicates - average results to be shown here

 

[offthelip]

this subroutine shows you how to do the first one

Sub test2()

inarr = Range(Cells(1, 1), Cells(lastrow_r, 7))
testdate = CDate(xCol2.Item(P))
Sum = 0
cnt = 0
For i = 8 To lastrow_r
 If inarr(i, 1) = testdate Then
  cnt = cnt + 1
  Sum = Sum + inarr(i, 5) * inarr(i, 3)
 End If
Next i
If cnt > 0 Then
Cells(1, 17) = Sum / cnt
Else
Cells(1, 17) = "N/A"
End If


End Sub

 

[kiran66]

Hii offthelip,

Thank you for your response, i think i was not given clarity to you. i need a macro code for weighted averages .

in the uploaded image, based on day wise values in the left side weighments columns will be converted to weighted average for the particular day those result will be shown in the right side of the weighments columns.

Date, BatchNo, Quantity, Weighments, count, grading , defects.........(left side of image).............Date, Quantity, Weighments, Count, Grading, Defects (right side of image)

i need macro code for weighted average for each particular day results will be shown in the right side of the image

 

[maabadi]

Hi. for weighted average you want to multiply columns with ?????. for example you want weighted average of Column E based Date, then what is criteria to multiply column E on it and then calculate average?
for Example you want weighted average of column E based Quantity (column B).

 

[kiran66]

hii
i have to multiply the E column based on date with respected quantity in c column

 

[maabadi]

You can Use this macro:

Sub WeightedAverage()
Dim Lrow As Long
Dim y As Long
Dim x As Long
Dim k As Long
Dim Z As Long
Dim Fcell As Range
Dim Ccell As Range
Dim Lrow2 As Long
Dim i As Long
Dim j As Long
Dim Cell As Range


Lrow = Cells(Rows.Count, 5).End(xlUp).Row
Lrow2 = Cells(Rows.Count, 16).End(xlUp).Row

For j = 17 To 19
For k = 8 To Lrow2
x = Application.WorksheetFunction.SumIf(Range("A8:A" & Lrow), Cells(k, 16), Range("C8:C" & Lrow))
    Z = 0
For i = 8 To Lrow
Set Fcell = Cells(i, j - 12)
Set Ccell = Cells(i, 3)
If Range("A" & i).Value = Cells(k, 16).Value Then
y = Fcell.Value * Ccell.Value
Else
y = 0
End If
Z = y + Z
Next i

Cells(k, j).Value = Z / x
Next k
Next j

End Sub

 

[maabadi]

Or Use this Function:
CRange is your Criteria range , for you A8:A & LastRow
Criteria is your Criteria , for you is P8
SumRange1 is your Sum range , for you E8:E & LastRow
SumRange2 is your Weighted range , for you C8:C & LastRow

Function WeightedAverage(CRange As Range, Criteria As Range, SumRange1 As Range, SumRange2 As Range) As Double
Dim Myformula As String
Dim x As Double
x = Application.WorksheetFunction.SumIf(CRange, Criteria, SumRange2)
Myformula = "=sumProduct(--(" & CRange.Address & " = " & Criteria.Address & "), " & SumRange1.Address & _
" , " & SumRange2.Address & " )"
WeightedAverage = Evaluate(Myformula) / x

End Function

 

[offthelip]

Hii offthelip,

Thank you for your response, i think i was not given clarity to you. i need a macro code for weighted averages .

in the uploaded image, based on day wise values in the left side weighments columns will be converted to weighted average for the particular day those result will be shown in the right side of the weighments columns.

Date, BatchNo, Quantity, Weighments, count, grading , defects.........(left side of image).............Date, Quantity, Weighments, Count, Grading, Defects (right side of image)

i need macro code for weighted average for each particular day results will be shown in the right side of the image

The code does do a weighted average, it multiplies column C by column E when summing the rows which meet the condition and then divides by the number, That is a weighted average!!

 

[kiran66]

Or Use this Function:
CRange is your Criteria range , for you A8:A & LastRow
Criteria is your Criteria , for you is P8
SumRange1 is your Sum range , for you E8:E & LastRow
SumRange2 is your Weighted range , for you C8:C & LastRow

Function WeightedAverage(CRange As Range, Criteria As Range, SumRange1 As Range, SumRange2 As Range) As Double
Dim Myformula As String
Dim x As Double
x = Application.WorksheetFunction.SumIf(CRange, Criteria, SumRange2)
Myformula = "=sumProduct(--(" & CRange.Address & " = " & Criteria.Address & "), " & SumRange1.Address & _
" , " & SumRange2.Address & " )"
WeightedAverage = Evaluate(Myformula) / x

End Function

Hii maabadi,
thank you for your response
can you check the code, what i have modified here is correct based on your code?

if any thing is wrong can you check and repost here

=Evaluate("=sumProduct(--(" & (Range("A8:A" & lastRow_R)) & " = " & (Range("P8:P" & lastRow_R)) & "), " & (Range("D8:D" & lastRow_R)) & " , " & (Range("C8:C" & lastRow_R)) & " )")

 

[maabadi]

this is I created is function. when you save file as .xlsm, and go to cell and import equal sign (=) and first letter of Function name (weighted) , it appears as suggestion and then you can select it from menu and import your range that you want.

if you want to modify code, you should do it on previous code.

AND if you don't want function, I should change first code again for column D.