Build a List with dates in a for loop VBA

Question

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.

Well, it skips since you are adding one month per loop, but you want two outputs per month. — Christofer Weber
– Christofer Weber, Commented Jul 30, 2021 at 23:53

Tim Williams · Accepted Answer · 2021-07-31 01:36:49Z

2

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

edited Jul 31, 2021 at 1:36

answered Jul 31, 2021 at 1:31

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

Sign up to request clarification or add additional context in comments.

Comments

Variatus · Accepted Answer · 2021-07-31 01:25:20Z

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.

Christofer Weber · Accepted Answer · 2021-07-31 01:13:21Z

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

Naresh · Accepted Answer · 2021-07-31 14:30:06Z

0

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

answered Jul 31, 2021 at 14:30

Naresh

3,0372 gold badges11 silver badges16 bronze badges

1 Comment

Naresh Over a year ago

If current date is 15 or last date of the month then this function considers it in the function result as the array starts from current date. If you want to skip it then just remove = out of <=. Also, no need to wrap the function in Transpose while entering in a worksheet row

Collectives™ on Stack Overflow

Build a List with dates in a for loop VBA

4 Answers 4

Comments

Comments

Comments

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

Comments

Comments

Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related