weighted average VBA Code

kiran66

New Member
Joined
Dec 8, 2020
Messages
12
Office Version
  1. 2019
Platform
  1. Windows
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
 

Attachments

  • Capture11.JPG
    Capture11.JPG
    58.5 KB · Views: 7

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,728
Office Version
  1. 2010
Platform
  1. Windows
this subroutine shows you how to do the first one
VBA Code:
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

New Member
Joined
Dec 8, 2020
Messages
12
Office Version
  1. 2019
Platform
  1. Windows
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

Well-known Member
Joined
Oct 22, 2012
Messages
1,606
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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

New Member
Joined
Dec 8, 2020
Messages
12
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,606
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
You can Use this macro:
VBA Code:
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

Well-known Member
Joined
Oct 22, 2012
Messages
1,606
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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
VBA Code:
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

Well-known Member
Joined
Dec 23, 2017
Messages
1,728
Office Version
  1. 2010
Platform
  1. Windows
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

New Member
Joined
Dec 8, 2020
Messages
12
Office Version
  1. 2019
Platform
  1. Windows
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
VBA Code:
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

Well-known Member
Joined
Oct 22, 2012
Messages
1,606
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,296
Messages
5,623,837
Members
415,995
Latest member
SergioCM92

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top