Build a List with dates in a for loop VBA

Solution for Build a List with dates in a for loop VBA
is Given Below:

I am trying to build a loop which prints a list with the 15th day and the last day of each month. The starting date of the list will depend on the current day (num_day), whereas the length of such list will depend on a given N number.

For example, if today is 30/07/2021 (dd/mm/yyyy format), and the N = 5 the list should be the following:

  • 31/07/2021, 15/08/2021, 31/08/2021, 15/09/2021, 30/09/2021

My current VBA code is the following:

Sub print_dates()
    
    N = 9
    For i = 0 To N - 1
        
        curr_day = DateAdd("m", i, Date)
        num_day = Format(Date, "dd")
        
        If num_day <= 15 Then
            If i Mod 2 = 0 Then
                print_day = "15/" & Format(curr_day, "mm") & "/" & Format(curr_day, "yyyy")
            Else
                print_day = DateSerial(Year(curr_day), Month(curr_day), 0)
            End If
        Else
            If i Mod 2 = 0 Then
                print_day = DateSerial(Year(curr_day), Month(curr_day), 0)
            Else
                print_day = "15/" & Format(curr_day, "mm") & "/" & Format(curr_day, "yyyy")
            End If
        End If
        
    Debug.Print print_day
        
    Next i

End Sub

With my current code the result of the list is:

  • 30/06/2021
  • 15/08/2021
  • 31/08/2021
  • 15/10/2021
  • 31/10/2021
  • 15/12/2021
  • 31/12/2021
  • 15/02/2022
  • 28/02/2022

The months with odd numbers (7, 9, 11, etc.) are being skipped by the code. Also, the list starts with last month’s last day.
Are there any suggestions on how to reach the desired result?

Thanks a lot in advance.

One more:

Sub print_dates()
    Dim dt As Date, i As Long
    dt = Date
    For i = 1 To 10
        dt = NextDate(dt)
        Debug.Print dt
    Next i
End Sub

'next date either 15th or last day of month
Function NextDate(ByVal dt As Date)
    Dim d As Long, ld As Long, m As Long, y As Long
    d = Day(dt)
    m = Month(dt)
    y = Year(dt)
    ld = Day(Application.EoMonth(dt, 0)) 'last day of the month
    
    NextDate = IIf(d < 15, DateSerial(y, m, 15), _
               IIf(d < ld, DateSerial(y, m, ld), DateAdd("d", 15, dt)))
End Function

The function below will return the list you want in an array of real dates.

Function DateList(ByVal Dstart As Date, _
                  ByVal Months As Integer) As Date()
    ' 300
    
    Dim Fun()       As Date                 ' list of dates
    Dim i           As Long                 ' index of Fun()
    Dim NextDate    As Date
    Dim n           As Integer              ' loop counter: Months
    
    ReDim Fun(1 To Months * 2)
    If Day(Dstart) < 15 Then
        i = 1
        Fun(i) = DateSerial(Year(Dstart), Month(Dstart), 15)
    End If
    NextDate = DateSerial(Year(Dstart), Month(Dstart) + 1, 1)
    For n = 1 To Months
        i = i + 1
        Fun(i) = NextDate - 1
        If i < UBound(Fun) Then
            i = i + 1
            Fun(i) = DateAdd("d", 14, NextDate)
            NextDate = DateAdd("m", 1, NextDate)
        End If
    Next n
    DateList = Fun
End Function

The function takes two arguments. The first date and the number of years. The first date need not be an ultimo or 15th because the function will determine the next available. Therefore you might call the function from your program as shown below.

Private Sub Test_PrintDates()
    ' 300
    
    Dim MyList()  As Date
    Dim f           As Long
    
    MyList = DateList(Date + 2, 3)
    For f = LBound(MyList) To UBound(MyList)
        Debug.Print Format(MyList(f), "ddd, mmmm dd, yyyy")
    Next f
End Sub

As you see, I used Date + 2 as the first date (Dstart) to test various start dates. The resulting list can be printed in any valid date format as demonstrated above.

Would something like this work better?

Sub print_dates()
Dim N As Long, num_day As Long
Dim curr_day As String, print_day As String

    N = 5
    For i = 1 To N / 2 + 0.5 Step 0.5 '<- Half step with compensation to N
        
        curr_day = DateAdd("m", i, Date)
        num_day = Format(Date, "dd")
        
        If num_day <= 15 Then
            If Int(i) / i = 1 Then '<- check for whole numbers instead
                print_day = "15/" & Format(curr_day, "mm") & "/" & Format(curr_day, "yyyy")
            Else
                curr_day = DateAdd("m", i + 1, Date) '<- random fix
                print_day = DateSerial(Year(curr_day), Month(curr_day), 0)
            End If
        Else
            If Int(i) / i = 1 Then '<- same change here
                print_day = DateSerial(Year(curr_day), Month(curr_day), 0)
            Else
                print_day = "15/" & Format(curr_day, "mm") & "/" & Format(curr_day, "yyyy")
            End If
        End If
        
    Debug.Print print_day
        
    Next i

End Sub

Following is an array function.

Option Explicit
Function HalfMonthDateSeries(myDate As Date, count As Long)
'Array (Contrl+Shift+Enter CSE) function
'returns one dimensional array of dateserial 15th and EOM from myDate
'While entering in a column wrap this function in transpose function
Dim arr(), i As Long
ReDim arr(count - 1) 'being 0 based one dimensional array

For i = LBound(arr) To UBound(arr)
    If i = LBound(arr) Then
        arr(i) = IIf(Day(myDate) <= 15, DateSerial(Year(myDate), _
        Month(myDate), 15), WorksheetFunction.EoMonth(myDate, 0))
    Else
        arr(i) = IIf(Day(arr(i - 1)) = 15, _
        WorksheetFunction.EoMonth(arr(i - 1) + 1, 0), arr(i - 1) + 15)
    End If
Next i
HalfMonthDateSeries = arr
End Function

In procedure

Sub Print_HalfMonthDateSeries()
Dim arr, i As Long
arr = HalfMonthDateSeries(Date, 5)
' or arr = HalfMonthDateSeries(#7/13/2021#, 5)
For i = LBound(arr) To UBound(arr)
    Debug.Print CDate(arr(i))
    ' or Cells(i + 2, 1) = CDate(arr(i))
Next i
End Sub