CODEWITHSUNDEEP
excelvba
Julia T.
Julia T.

Reputation: 53

Calculating averages over irregular time periods?

I'm just a beginner in VBA, so it would be really nice if somebody could me help out a bit here:

I have a table with yearly sales data like:

However, it could be that an item only started selling in 2007 on September 1 (09/01/2007) and ended selling in 2010 on April 1/2010 (04/01/2010).

Now I want to calculate one overall yearly average. The way I do it is to it all by hand:

It would make my life so much easier if I could give excel a date range (09/01/2007 to 04/01/2010) and it would give me the output:

Please see image below to make it a bit easier to understand:

enter image description here

Upvotes: 0

Views: 445

Answers (1)

Xabier
Xabier

Reputation: 7735

All you need for this to work is a beginning date and end date on cells G1 and G2, and the sales per year on Columns A & B, then the code will populate your Factor and Multiplied on columns C & D, and give you a result on cell A10. So you wouldn't need anything below row 13 in your example.

Sub foo()

Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
'get the last row with data on Column A

BeginningDate = Format(ws.Range("G1"), "dd/mm/yyyy") 'get the beginning date from cell G1
EndDate = Format(ws.Range("G2"), "dd/mm/yyyy") 'get the end date from cell G2

Years = DateDiff("yyyy", BeginningDate, EndDate) + 1 'get the number of years to run a loop

CurrentDate = BeginningDate

For i = 1 To Years 'loop as many years between dates
    LastDayOfYear = "31/12/" & Year(CurrentDate) 'get the last day of the given year
    DaysDiff = DateDiff("d", CurrentDate, EndDate) 'calculate the days between Current and EndDate
    If DaysDiff > 365 Then 'if more than a year between
        CurrentDays = DateDiff("d", CurrentDate, LastDayOfYear)
        If CurrentDays = 364 Then CurrentDays = 365 'uncomment this line if you want your calculations to assume every year has 365 days
        Factor = CurrentDays / 365
        ws.Cells(i + 1, 3) = Factor
        ws.Cells(i + 1, 4) = Factor * ws.Cells(i + 1, 2)
        CurrentDate = DateAdd("d", 1, LastDayOfYear)
    Else
        Factor = DaysDiff / 365
        ws.Cells(i + 1, 3) = Factor
        ws.Cells(i + 1, 4) = Factor * ws.Cells(i + 1, 2)
        CurrentDate = DateAdd("d", 1, LastDayOfYear)
    End If
Next i
ws.Range("A10").Value = WorksheetFunction.Sum(ws.Range("D2:D" & Years + 1)) / WorksheetFunction.Sum(ws.Range("C2:C" & Years + 1))
End Sub

Upvotes: 0

Related Questions