# 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
'-----------------------------------

'Initialize the text boxes

Me.txtStartDate = Date
Me.txtRecur = 1

End Sub

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
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

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

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```

#### “Go Fund Me” Page

(\$5 suggested amount)

by
Tags: