I made the code very versitile to cover multiple years. I assume the
original data was on sheet1. You'll need to create a sheet called SUMMARY
where the results will go. The code finds the earliest and latest dates in
the original input. the it creates a serperate row on the summary sheet for
each month putting both the month and Year in column A.
Then the code looks at each line of the input data and add the number of
orders to the summary sheet.
Sub CreateSummary()
With Sheets("Sheet1")
MinDate = WorksheetFunction.Min(.Columns("C"))
MaxDate = WorksheetFunction.Max(.Columns("D"))
End With
MinMonth = Month(MinDate)
MinYear = Year(MinDate)
MaxMonth = Month(MaxDate)
MaxYear = Year(MaxDate)
'Put dates in column A on the Summary worksheet
With Sheets("Summary")
.Range("A1") = "Month/Year"
.Columns("A").NumberFormat = "MM/YY"
RowCount = 2
Yearcount = MinYear
MonthCount = MinMonth
Do While (Yearcount <= MaxYear) And _
(MonthCount <= MaxMonth)
.Range("A" & RowCount) = _
DateSerial(Yearcount, MonthCount, 1)
MonthCount = MonthCount + 1
If MonthCount = 13 Then
MonthCount = 1
Yearcount = Yearcount + 1
End If
RowCount = RowCount + 1
Loop
End With
'Adds orders from Sheet1 to the summary sheet
With Sheets("sheet1")
RowCount = 2
Do While .Range("A" & RowCount) <> ""
StartDate = .Range("C" & RowCount)
EndDate = .Range("D" & RowCount)
Orders = .Range("B" & RowCount)
NumberOfMonths = 12 * (Year(EndDate) - Year(StartDate)) + _
(Month(EndDate) - Month(StartDate)) + 1
OrdersPerMonth = Orders / NumberOfMonths
With Sheets("Summary")
'find Start Date
'get first day of the month for StartDate
Start = DateSerial(Year(StartDate), Month(StartDate), 1)
'Convert to string
StartStr = Format(Start, "MM/YY")
Set c = .Columns("A").Find(what:=StartStr, _
LookIn:=xlValues, lookat:=xlWhole)
For i = c.Row To (c.Row + NumberOfMonths - 1)
.Range("B" & i) = .Range("B" & i) + _
OrdersPerMonth
Next i
End With
RowCount = RowCount + 1
Loop
End With
End Sub
