How To Calculate Date Intervals With VBA DateAdd

One of my clients ask me to design a little utility to operate like the Outlook appointment
recurrence feature.

This the first basic step, so I wanted to share how I did it.

I have a basic form where I’ll probably be adding more variables, but the functionality basically works like this:

I have an input box for the start date, and how many times the occurrence should happen, and then at what frequency (monthly, quarterly, yearly, or semiannually)

Option Compare Database
'-----------------------------------
'CODE BY LOEBLCOMSERVICES 2018
'erik@loeblcomservices.com
'-----------------------------------


Private Sub Form_Load()

    'Initialize the text boxes
    
    Me.txtStartDate = Date
    Me.txtRecur = 1
    
End Sub


Private Sub btnAddNew_Click()
 
    Dim intFrequency As Integer
    
    'Get the first date
    dteStartDate = CDate(Me.txtStartDate)
    
    'How many date intervals will we need?  Default to 1, if this is blank.
    intFrequency = Nz(Me.txtRecur, 1)
    
    'Delete what's currently in the table
    CurrentDb.Execute "DELETE * FROM tblFrequencies"
    
    'Select the date frequency based on an option group, and pass the _
        required information to the next procedure.
    
    Select Case Me.fraFrequency
        Case 1 'monthly
            Frequencies dteStartDate, "m", 1, intFrequency
        Case 2 'quarterly
            Frequencies dteStartDate, "m", 3, intFrequency
        Case 3 'yearly
            Frequencies dteStartDate, "m", 12, intFrequency
        Case 4 'semi annually
            Frequencies dteStartDate, "m", 6, intFrequency

    End Select
    
    DoCmd.OpenQuery "qryFrequencies"

End Sub

Sub Frequencies(dteStartDate, interval, subinterval, times)
    
    'Insert the start date into the table
    CurrentDb.Execute "INSERT INTO tblFrequencies (DateNum,NewDate) VALUES(1,'" & dteStartDate & "')"
    
    'Get the next date due by using the DateAdd function
    dteNextDueDate = DateAdd(interval, subinterval, dteStartDate)
    Debug.Print "Next Date Due= " & dteNextDueDate
    
    'Insert the next date due.
    CurrentDb.Execute "INSERT INTO tblFrequencies (DateNum,NewDate) VALUES(2,'" & dteNextDueDate & "')"
         
    'Alternate between the next 2 procedures until the "times" variable is reached
    Getdates1 dteNextDueDate, interval, subinterval, 2, times
    
End Sub

Sub Getdates1(NextDueDate, interval, intSubInterval, current, TotalTimes)
    
    If current < TotalTimes Then
        
        'Use the DateAdd function again to get the next iteration date
        dteNextDueDate = DateAdd(interval, intSubInterval, NextDueDate)
        
        Debug.Print dteNextDueDate
        
        'Increment the counter to pass to the next procedure
        current = current + 1
        
        'Insert the value
        CurrentDb.Execute "INSERT INTO tblFrequencies (DateNum,NewDate) VALUES(" & current & ",'" & dteNextDueDate & "')"
               
        Getdates2 dteNextDueDate, interval, intSubInterval, current, TotalTimes
    End If
End Sub

Sub Getdates2(NextDueDate, interval, intSubInterval, current, TotalCt)
        
    'Use the DateAdd function again to get the next due date
    dteNextDueDate = DateAdd(interval, intSubInterval, NextDueDate)
    
    
    Debug.Print dteNextDueDate
    
    'Increment the counter to pass to the next procedure
    current = current + 1
    
    'Insert the value
    CurrentDb.Execute "INSERT INTO tblFrequencies (DateNum,NewDate) VALUES(" & current & ",'" & dteNextDueDate & "')"

  
    'Call the first procedure again until the interval is reached
    Getdates1 dteNextDueDate, interval, intSubInterval, current, TotalCt
    

End Sub

Click here to download the sample database: “How To Calculate Date Intervals With VBA DateAdd”

By the way, if you got or are getting value from the VBA information, please give me a tip, thanks!