In the code below, we are searching through a list of roughly 500 items to identify which items belong to Rate A and Rate B, then adding the number of hours recorded to a running total.
We also want to set an arbitrary number of rate periods - dividing the total period (approximately 2018 to 2021) into blocks. The first block will always begin before the start of the data and the last block will go right to the end of it.
Rate Period Dialog has a DTPicker object on it.
When we have only 1 rate period, the totals are summed correctly. When we have 2 rate periods and the date is entered (for example) as 01/01/2020, the first rate period totals appear to be calculated correctly, but the second is lower than it should be. When we have 2 rate periods and a different date is entered using the DTPicker, where the day is greater than 12 (for example - 13/01/2020), all rate periods are shown as zero for both Rate A and Rate B.
UK date format (dd/mm/yyyy) applies, though this will hopefully not matter (using DTPicker and DateSerial)
Public rateAHours() As Single
Public rateBHours() As Single
Sub DebugSumRateData()
'Define ranges for Work Hours (sumRange), column with rate data (A, B or otherwise) and column with date of work
Dim sumRange As Range
Dim rateRange As Range
Dim dateRange As Range
Dim periodStartDate As Date
Dim periodEndDate As Date
Set dateRange = Range("Data!B:B")
Set rateRange = Range("Data!E:E")
Set sumRange = Range("Data!F:F")
'Setup dates for rate period
numberOfRatePeriods = InputBox("How many rate periods apply to this schedule?", "Number of Rate Periods")
'Set all arrays to the size required for the number of rate periods
ReDim endDates(numberOfRatePeriods) As Date
ReDim rateAHours(numberOfRatePeriods) As Single
ReDim rateBHours(numberOfRatePeriods) As Single
If (numberOfRatePeriods > 1) Then
For i = 1 To numberOfRatePeriods - 1
RatePeriodDialog.DatePromptLabel = "Please enter end date of rate period " & i
RatePeriodDialog.Show
endDates(i) = ratePeriodInputDate
Next i
End If
'Final rate period is until end of time (or near enough)
endDates(numberOfRatePeriods) = DateSerial(9999, 1, 1)
periodStartDate = DateSerial(1900, 1, 1)
For i = 1 To UBound(endDates)
periodEndDate = endDates(i)
MsgBox "Start of loop " & i & " - Start Date is " & periodStartDate & " End Date is " & periodEndDate
rateAHours(i) = WorksheetFunction.SumIfs(sumRange, rateRange, "A", dateRange, ">=" & periodStartDate, dateRange, "<=" & periodEndDate)
rateBHours(i) = WorksheetFunction.SumIfs(sumRange, rateRange, "B", dateRange, ">=" & periodStartDate, dateRange, "<=" & periodEndDate)
periodStartDate = DateAdd("d", 1, periodEndDate)
MsgBox "End of loop " & i & " - Start Date is " & periodStartDate & " End Date is " & periodEndDate
'Debug Message Box - shows all rate totals for this loop
MsgBox rateAHours(i) & vbCrLf & _
rateBHours(i) & vbCrLf
Next i
End Sub
When entering 1 rate period, all work hours at Rate A and Rate B are calculated and stored in the array (Debug Message Box at end of Loop reports 75.5 and 7.2)
When using 2 or more rate periods, work hours are inconsistent - some missing in each case (2 rate periods, date for end of Rate Period of 01/01/2020 - Debug Message Box reports 49 and 7.1 (1st Loop) & 22.3 and 0.1 (2nd Loop))
Where the day element of an "end of period" date is greater than 12, all sums return as 0 from WorksheetFunction.SumIfs (checked in VBA debug stepthrough) (2 rate periods, date for end of Rate Period of 13/01/2020 - Debug Message Box reports 0 and 0 (both loops)
On the edge case where the end of rate period is 12/01/2020, acts as though all data was before this date (2 rate periods, date for end of Rate Period of 12/01/2020 - Debug Message Box reports 75.5 and 7.2 (1st Loop) & 0 and 0 (2nd Loop) - data continues until Jan 2021, with many items for Rate A and B
Debug messages at start and end confirm correct dates being used for the SumIfs in each loop
You should convert the dates to Long integers using CLng - for example:
rateAHours(i) = WorksheetFunction.SumIfs(sumRange, rateRange, "A", dateRange, ">=" & CLng(periodStartDate), dateRange, "<=" & CLng(periodEndDate))