Calculating weighted averges betwwn different time periods

N

nagaraj45

I have the follwing worksheet"

Date Rate Qty
2:06:56 PM 199.5 116
2:06:49 PM 199.5 343
2:06:40 PM 199.5 226
2:06:28 PM 199.5 48
2:06:20 PM 199.4 162
2:06:11 PM 199.5 95
2:06:04 PM 199.4 449
2:05:58 PM 199.6 1488
2:05:40 PM 199.5 9
2:05:40 PM 199.5 9
2:05:37 PM 199.4 161
2:05:28 PM 199.6 101
2:05:23 PM 199.35 4605
2:05:15 PM 199.5 5926
2:05:06 PM 199.6 217
2:04:57 PM 199.6 3
2:04:52 PM 199.75 207
2:04:44 PM 199.6 4180
2:04:39 PM 199.8 75
2:04:32 PM 199.55 2277
2:04:20 PM 199.7 194
2:04:13 PM 199.5 4280
2:04:09 PM 199.7 780
2:03:58 PM 199.7 108
2:03:49 PM 199.7 10
2:03:46 PM 199.7 3006
2:03:32 PM 199.75 1471
2:03:22 PM 199.6 217
2:03:16 PM 199.7 815
2:03:10 PM 199.7 271
2:03:04 PM 199.6 400
2:02:54 PM 199.75 50
2:02:48 PM 199.75 168
2:02:39 PM 199.75 210
2:02:24 PM 199.75 257
2:02:19 PM 199.5 1067
2:02:12 PM 199.85 2055
2:01:59 PM 199.55 2
2:01:53 PM 199.95 114
2:01:48 PM 199.4 4544
2:01:43 PM 200 143
2:01:35 PM 200 736
2:01:28 PM 199.9 212
2:01:20 PM 199.8 325
2:01:12 PM 199.5 10100
2:01:03 PM 199.8 2873
2:00:58 PM 199.8 492
2:00:44 PM 200.2 551
2:00:37 PM 199.85 2965
2:00:28 PM 199.85 1429
2:00:20 PM 199.65 474
2:00:13 PM 199.9 2226
2:00:02 PM 200 168
1:59:57 PM 199.65 33
1:59:50 PM 199.6 47

I would like to calculate the weighed average rate( rate*qty/total qty
durig a period) for different periods say 2.00 pm to 2.01 pm, 2.01pm
to 2.02 pm etc. Is there a way to do this by using
database(dsum,daverage) functions. What will be the content of the
criterion range?

Or is there any other way of solving this. Thanks ln advance
 
B

Billy Liddel

One other way using this macro.

Sub listUnique()
Dim col As Integer, startR As Integer, r As Long
Dim CuProd As Double, CuQty As Long, lr As Long, l As Long
Dim row As Long, i As Long, TCol As Integer, lst

Set rng = Selection
l = Selection.Rows.Count
r = ActiveCell.row - 1: startR = ActiveCell.row: TCol = ActiveCell.Column
lr = startR + l - 1: col = TCol + 4: row = r

For i = startR To lr
d = Int(Cells(i, TCol) * 1440) * 1 / 1440
Set lst = Range(Cells(startR, col), Cells(row, col))
x = Application.Match(d, lst, 0)
If IsError(x) Then
row = row + 1
Cells(row, col) = d
CuProd = Cells(i, TCol + 1) * Cells(i, TCol + 2)
CuQty = Cells(i, TCol + 2)
Cells(row, col + 1) = Cells(i, 2)
Else
CuQty = CuQty + Cells(i, TCol + 2)
CuProd = CuProd + Cells(i, TCol + 1) * Cells(i, TCol + 2)
Cells(row, col + 1).Value = Application.Round(CuProd / CuQty, 3)
End If
Next i

End Sub

Copy the macro into a VB Module, Alt + F11, Insert module copy the code and
return to workbook.

Select the dates and run the code.

Assumptions: there are three columns of data only - the times in minutes and
the weighted rates are listed in columns E and F.

If therer are more than 3 columns in the data you need to alter the number
of columns to offset the calculations. On your data the following results are
given.

Time Col
2:06 PM 199.458
2:05 PM 199.458
2:04 PM 199.567
2:03 PM 199.702
2:02 PM 199.734
2:01 PM 199.557
2:00 PM 199.875
1:59 PM 199.621

Regards
Peter
 
N

nagaraj45

One other way using this macro.

Sub listUnique()
Dim col As Integer, startR As Integer, r As Long
Dim CuProd As Double, CuQty As Long, lr As Long, l As Long
Dim row As Long, i As Long, TCol As Integer, lst

Set rng = Selection
l = Selection.Rows.Count
r = ActiveCell.row - 1: startR = ActiveCell.row: TCol = ActiveCell.Column
lr = startR + l - 1: col = TCol + 4: row = r

For i = startR To lr
  d = Int(Cells(i, TCol) * 1440) * 1 / 1440
  Set lst = Range(Cells(startR, col), Cells(row, col))
    x = Application.Match(d, lst, 0)
    If IsError(x) Then
    row = row + 1
      Cells(row, col) = d
     CuProd = Cells(i, TCol + 1) * Cells(i, TCol + 2)
     CuQty = Cells(i, TCol + 2)
      Cells(row, col + 1) = Cells(i, 2)
      Else
        CuQty = CuQty + Cells(i, TCol + 2)
        CuProd = CuProd + Cells(i, TCol + 1) * Cells(i, TCol + 2)
        Cells(row, col + 1).Value = Application.Round(CuProd / CuQty, 3)
    End If
Next i

End Sub

Copy the macro into a VB Module, Alt + F11, Insert module copy the code and
return to workbook.

Select the dates and run the code.

Assumptions: there are three columns of data only - the times in minutes and
the weighted rates are listed in columns E and F.

If therer are more than 3 columns in the data you need to alter the number
of columns to offset the calculations. On your data the following results are
given.

Time    Col
2:06 PM 199.458
2:05 PM 199.458
2:04 PM 199.567
2:03 PM 199.702
2:02 PM 199.734
2:01 PM 199.557
2:00 PM 199.875
1:59 PM 199.621

Regards
Peter








- Show quoted text -
Click to expand...

I copied the macro and it works fine though I am unable to get into
the nitty gritty of the code as I am new to VBA. On running the macro
i am able to get the the weighted average rates for every minute of
the selected range. Is there a way to get the total quanity during
every period? Also If it is not asking for too much, is it possible to
change the duration, say every 5 minutes or every 10 minutes and get
the total quantity and weighted averages during such periods?

Thanks as always.
 
B

Billy Liddel

I'll have to get back to you - but do you want to be able to change the
number of minutes each time you run the macro?

Peter

"> I copied the macro and it works fine though I am unable to get into
 
B

Billy Liddel

Ok I have rewritten the macro and it works for 1 or two minutes. You will be
prompted to enter the number of minutes you wish to analyse. It will work
whenever the period you choose divide neatly into the numer of minutes in the
day i.e. 1440.

There may be a problem, not tested, where the number is a prime of seven or
above or multiples of the a prime e.g. 14, 22. You might like to test this
with more data and let me know, I'm curious to find out. the revised code is:

Sub WghtdAve2()
Dim col As Integer, startR As Integer, r As Long
Dim CuProd As Double, CuQty As Long, lr As Long, l As Long
Dim row As Long, i As Long, TCol As Integer, lst
Dim d, Header, myMins As Integer, myrate As Double

Const MINUTESPERDAY As Integer = 1440
myMins = InputBox("Enter Minutes to Analyse", "Specify Time Period", 2, 100,
100)
myrate = MINUTESPERDAY / myMins
Set rng = Selection
l = Selection.Rows.Count
r = ActiveCell.row - 1: startR = ActiveCell.row: TCol = ActiveCell.Column
lr = startR + l - 1: col = TCol + 4: row = r
Header = Array("Time", "wRate", "Tot Q")
Cells(1, col).CurrentRegion.ClearContents
Range(Cells(1, col), Cells(1, col + 2)) = Header
Application.ScreenUpdating = False
For i = startR To lr
d = Int(Cells(i, TCol) * myrate) * 1 / myrate
Set lst = Range(Cells(startR, col), Cells(row, col))
x = Application.Match(d, lst, 0)
If IsError(x) Then
row = row + 1
Cells(row, col) = d
CuProd = Cells(i, TCol + 1) * Cells(i, TCol + 2)
CuQty = Cells(i, TCol + 2)
Cells(row, col + 1) = Cells(i, 2)
Cells(row, col + 2) = CuQty
Else
CuQty = CuQty + Cells(i, TCol + 2)
CuProd = CuProd + Cells(i, TCol + 1) * Cells(i, TCol + 2)
Cells(row, col + 1).Value = Application.Round(CuProd / CuQty, 3)
Cells(row, col + 2) = CuQty
End If
Next i
Cells(1, col).Select
Application.ScreenUpdating = True
End Sub

Look forward to hearing about primes!
Regards
Peter
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Looking for formula 20
Grouping Time in Pivots. 2
Subtracting time...again 2
Overlapping time ranges 2
Formula For Time Duration Calculation 1
add time with out weekends 3
Suming Up Time over the course of days 1
Weeknum Within a Range 5

Top