# 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

##### Well-known Member
This is images for function.

#### Attachments

• 11111.jpg
35.7 KB · Views: 2
• 22222.jpg
76.2 KB · Views: 2

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

#### kiran66

##### New Member
I will post my macro, can you modify the code and repost it here please. code in module 1 from line number 376 to 383

drive

##### Well-known Member
VBA Code:
``Dim x as long``
to the first of your code
VBA Code:
`````` Range("N" & P + 7) = CDate(xCol2.Item(P))
Range("O" & P + 7) = Round(WorksheetFunction.SumIf(Range("A8:A" & lastRow_R), CDate(xCol2.Item(P)), Range("C8:C" & lastRow_R)), 2)
x = Application.WorksheetFunction.SumIf(Range("A8:A" & lastRow_R), CDate(xCol2.Item(P)), Range("C8:C" & lastRow_R))
Range("P" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & CDate(xCol2.Item(P)) & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("D8:D" & lastRow_R).Address & " )") / x, 2)
Range("Q" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & CDate(xCol2.Item(P)) & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("E8:E" & lastRow_R).Address & " )") / x, 2)
Range("R" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & CDate(xCol2.Item(P)) & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("F8:F" & lastRow_R).Address & " )") / x, 2)
Range("S" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & CDate(xCol2.Item(P)) & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("G8:G" & lastRow_R).Address & " )") / x, 2)
Range("T" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & CDate(xCol2.Item(P)) & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("H8:H" & lastRow_R).Address & " )") / x, 2)``````

#### kiran66

##### New Member
i have tried but i am getting result as "0"
can you try the code and repost the excel here please

##### Well-known Member

you can Test Previous code After This Line
VBA Code:
``Range("N" & P + 7) = CDate(xCol2.Item(P))``
with
VBA Code:
``````Debug.print CDate(xCol2.Item(P))
Debug.print CDate(xCol2.Item(P)).value

And see what is result at Immediate window
And then Paste result here.

I don't have CDate(xCol2.Item(P))
and Use this code and it working:
VBA Code:
``````Dim Criteria as Range
Set Criteria = Range("N" & P + 7)
Range("O" & P + 7) = Round(WorksheetFunction.SumIf(Range("A8:A" & lastRow_R), Criteria, Range("C8:C" & lastRow_R)), 2)
x = Application.WorksheetFunction.SumIf(Range("A8:A" & lastRow_R), Criteria, Range("C8:C" & lastRow_R))
Range("P" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("D8:D" & lastRow_R).Address & " )") / x, 2)
Range("Q" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("E8:E" & lastRow_R).Address & " )") / x, 2)
Range("R" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("F8:F" & lastRow_R).Address & " )") / x, 2)
Range("S" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("G8:G" & lastRow_R).Address & " )") / x, 2)
Range("T" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("H8:H" & lastRow_R).Address & " )") / x, 2)``````

#### kiran66

##### New Member
i am posting my excel file can you check it once . i don't no why i am getting zeros in the p,q,r,s,t columns

##### Well-known Member

After Line 370
Between 'MsgBox (xCol2.Count) to Before For V = 8 To lastRow_R
Change code to this:
VBA Code:
``````Dim x As Long
Dim Criteria As Range
ActiveWorkbook.Worksheets(r).Activate
lastRow_R = Worksheets(r).Range("A" & Rows.Count).End(xlUp).Row
For P = 1 To xCol2.Count
'MsgBox (xCol2.Item(P))
Range("N" & P + 7) = CDate(xCol2.Item(P))
Set Criteria = Range("N" & P + 7)
Range("O" & P + 7) = Round(WorksheetFunction.SumIf(Range("A8:A" & lastRow_R), CDate(xCol2.Item(P)), Range("C8:C" & lastRow_R)), 2)
x = Application.WorksheetFunction.SumIf(Range("A8:A" & lastRow_R), CDate(xCol2.Item(P)), Range("C8:C" & lastRow_R))
Range("P" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("D8:D" & lastRow_R).Address & " )") / x, 2)
Range("Q" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("E8:E" & lastRow_R).Address & " )") / x, 2)
Range("R" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("F8:F" & lastRow_R).Address & " )") / x, 2)
Range("S" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("G8:G" & lastRow_R).Address & " )") / x, 2)
Range("T" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("H8:H" & lastRow_R).Address & " )") / x, 2)``````

#### kiran66

##### New Member
After Line 370
Between 'MsgBox (xCol2.Count) to Before For V = 8 To lastRow_R
Change code to this:
VBA Code:
``````Dim x As Long
Dim Criteria As Range
ActiveWorkbook.Worksheets(r).Activate
lastRow_R = Worksheets(r).Range("A" & Rows.Count).End(xlUp).Row
For P = 1 To xCol2.Count
'MsgBox (xCol2.Item(P))
Range("N" & P + 7) = CDate(xCol2.Item(P))
Set Criteria = Range("N" & P + 7)
Range("O" & P + 7) = Round(WorksheetFunction.SumIf(Range("A8:A" & lastRow_R), CDate(xCol2.Item(P)), Range("C8:C" & lastRow_R)), 2)
x = Application.WorksheetFunction.SumIf(Range("A8:A" & lastRow_R), CDate(xCol2.Item(P)), Range("C8:C" & lastRow_R))
Range("P" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("D8:D" & lastRow_R).Address & " )") / x, 2)
Range("Q" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("E8:E" & lastRow_R).Address & " )") / x, 2)
Range("R" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("F8:F" & lastRow_R).Address & " )") / x, 2)
Range("S" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("G8:G" & lastRow_R).Address & " )") / x, 2)
Range("T" & P + 7) = Round(Evaluate("=sumProduct(--(" & Range("A8:A" & lastRow_R).Address & " = " & Criteria.Address & "), " _
& Range("C8:C" & lastRow_R).Address & " , " & Range("H8:H" & lastRow_R).Address & " )") / x, 2)``````
Thank you very much its working fine

##### Well-known Member
You 're Welcome & thanks for feedback.

#### kiran66

##### New Member
You 're Welcome & thanks for feedback.
Hii,

can i get the same code in the module 3 line number 53 we are getting average for the total number of quantities here also we need weighted average

Replies
2
Views
127
Replies
18
Views
463
Replies
3
Views
107
Replies
11
Views
205
Replies
5
Views
282

1,126,896
Messages
5,621,495
Members
415,844
Latest member

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