Total days between two dates by Month

0
votes

Does anyone suggest a VBA function to do the same? Return that in an array format would be useful so I can use that in other calculations. This is required for cash flow calculations through VBA.

Start Date - 01/Jan/2015
End Date - 05/Mar/2015

VBA Result

Count        Month        Month Days
1           1/Jan/2015    31
2           1/Feb/2015    28
3           1/Mar/2015     5

Note- If the supplied dates are wrong, then VBA has to assume default dates

2
vbaexcel

2 Answers

0
votes

Something like this?

Function GetTable(startDate As Double, endDate As Double) As Variant
  Dim Table() As Variant, i As Long, y As Byte: i = 1: y = Day(startDate)
  If endDate <= startDate Then GetTable = "error": Exit Function
  ReDim Table(2, 0)
  Table(0, 0) = "Count"
  Table(1, 0) = "Month"
  Table(2, 0) = "Month Days"
  For startDate = startDate To endDate - 1
    If Month(startDate + 1) <> Month(startDate) Then
      ReDim Preserve Table(2, UBound(Table, 2) + 1)
      Table(0, UBound(Table, 2)) = UBound(Table, 2)
      If UBound(Table, 2) = 1 Then
        Table(1, UBound(Table, 2)) = y & Format(startDate, "/mmm/yyyy")
      Else
        Table(1, UBound(Table, 2)) = Format(startDate, "1/mmm/yyyy")
      End If
      Table(2, UBound(Table, 2)) = i
      i = 1
    Else
      i = i + 1
    End If
  Next
  ReDim Preserve Table(2, UBound(Table, 2) + 1)
  Table(0, UBound(Table, 2)) = UBound(Table, 2)
  If UBound(Table, 2) = 1 Then
    Table(1, UBound(Table, 2)) = y & Format(startDate, "/mmm/yyyy")
  Else
    Table(1, UBound(Table, 2)) = Format(startDate, "1/mmm/yyyy")
  End If
  Table(2, UBound(Table, 2)) = i
  GetTable = Table
End Function
0
votes

Here's another way you could do this:

Function to get # of days in a month:

' https://msdn.microsoft.com/en-us/library/aa227538(v=vs.60).aspx
Function dhDaysInMonth(Optional dtmDate As Date = 0) As Integer
    If dtmDate = 0 Then
        dtmDate = Date
    End If
    dhDaysInMonth = DateSerial(Year(dtmDate), _
     Month(dtmDate) + 1, 1) - _
     DateSerial(Year(dtmDate), Month(dtmDate), 1)
End Function

Function to populate array with required information

Function GetDateArray(StartDate As Date, EndDate As Date)

    Dim Holder() As Variant
    Dim i As Date, Count As Integer, temp As Integer

    my = Format(StartDate, "mm/yyyy")
    Count = 0

    ' pass 1 - find out how many months we encountered
    ' set up the array bounds accordingly
    For i = StartDate To EndDate
        ' each time month/year combination changes, we increment our count
        If Format(i, "mm/yyyy") <> my Then
            Count = Count + 1
            my = Format(i, "mm/yyyy")
        End If
    Next
    ReDim Holder(1 To Count + 1, 1 To 3)

    my = Format(StartDate, "mm/yyyy")
    Count = 0

    ' pass 2 - populate the array with information
    For i = StartDate To EndDate
        If Format(i, "mm/yyyy") <> my Then
            Count = Count + 1

            ' find days in the month
            temp = dhDaysInMonth(i - 1)
            If Count = 1 Then
                temp = temp - Format(StartDate, "dd") + 1
            End If

            ' populate array
            Holder(Count, 1) = Count
            Holder(Count, 2) = "01" & "/" & Format(i - 1, "mmm/yyyy")
            Holder(Count, 3) = temp

            ' reset mm/yyyy we remembered
            my = Format(i, "mm/yyyy")
        End If
    Next

    ' handle the last month's information
    Count = Count + 1
    temp = Format(EndDate, "dd")
    Holder(Count, 1) = Count
    Holder(Count, 2) = "01" & "/" & Format(i - 1, "mmm/yyyy")
    Holder(Count, 3) = temp

    GetDateArray = Holder

End Function

Test to make sure function returns what we need

Sub test()

    ' get data you desire
    Dim Holder() As Variant
    Holder = GetDateArray("2/27/2015", "5/5/2015")

    ' debug/print the array just as a proof
    Dim Row As Integer, Col As Integer, TempStr As String
    For Row = 1 To UBound(Holder, 1)
        TempStr = ""
        For Col = 1 To UBound(Holder, 2)
            TempStr = TempStr & Holder(Row, Col) & " | "
        Next
        Debug.Print TempStr
    Next

End Sub

Result (between 27th Feb and 5th May 2015):

1 | 01/Feb/2015 | 2 | 
2 | 01/Mar/2015 | 31 | 
3 | 01/Apr/2015 | 30 | 
4 | 01/May/2015 | 5 |