# weighted average VBA Code

#### kiran66

##### New Member
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
58.5 KB · Views: 7

### 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
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
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

##### Well-known Member
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

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

##### Well-known Member
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``````

##### Well-known Member

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
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
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``````
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)) & " )")

##### Well-known Member
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.

Replies
2
Views
129
Replies
18
Views
466
Replies
3
Views
109
Replies
11
Views
211
Replies
4
Views
84

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.

### Which adblocker are you using?

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

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