Calculated Future Dates

[Monterey_Manzer]

Howdy All,



I have a situation where I want to display a series of dates on a form. However, by setting the first date in this series, the remaining dates are predetermined and I would like to automate this feature. Specifically, these dates will always be the third Friday of every month. Ideally my form users will select the first date in the series and the next two dates (the rest of the series) would be determined via a VBA formula that would determine the date of the third Friday of the following month. I've seen people using the iif command to handle skipping weekends when calculating differences in dates but I can't see if that would apply here. I'm trying to figure out how I would correct for the different weekdays at the start of each month and the different total days in each month. I would appreciate any help anyone could give.

Thanks!

[pbaldy]

A brief Google turned this up:

http://www.pcreview.co.uk/forums/cal...-t3876459.html

You should be able to use that and DateAdd() to calculate the 3rd Friday for the months following the input date.

[Monterey_Manzer]

Thanks! Rather than use DateAdd() I pulled my Month and Year integers called for in the DayInMonth function from my first date field using the Month() and Year() functions. I then set the calculation to include a +1 to the Month integer. Using this method I was able to set my second date to the 3rd Friday of the following month. This works great! In case it will help anyone else, here's the code I used:

<code>
Public Function DayInMonth(WeekNumber As Integer, Wkday As Integer, dMonth As Integer, dYear As Integer) As Date

Dim FirstOfMonth As Date
Dim NextWeekDay As Integer
Dim RootDate As Date

FirstOfMonth = DateSerial(dYear, dMonth, 1)
NextWeekDay = IIf(Wkday = vbSaturday, vbSunday, Wkday + 1)
RootDate = FirstOfMonth - Weekday(FirstOfMonth, NextWeekDay)
DayInMonth = RootDate + WeekNumber * 7

End Function

Private Sub First_ISP_AfterUpdate()
'The date for the second ISP will be set once the date of the first is updated.
Me.Second_ISP.Value = DayInMonth(3, vbFriday, Month(Me.First_ISP.Value) + 1, Year(Me.First_ISP.Value))
End Sub
</code>

[pbaldy]

Hopefully that works in December.

[Monterey_Manzer]

Okay, I've got a better one for you that DOES work when I give it dates either in December or November (since we're talking about computing out to two months in the future):

Private Sub First_ISP_AfterUpdate()
'Calculating the third Friday of the month following the month of the first ISP.  If,Then statements used to cover potential change in years.
     If Month(Me.First_ISP.Value) = 12 Then
     Me.Second_ISP.Value = DayInMonth(3, vbFriday, 1, Year(Me.First_ISP.Value) + 1)
     ElseIf Month(Me.First_ISP.Value) < 12 Then
     Me.Second_ISP.Value = DayInMonth(3, vbFriday, Month(Me.First_ISP.Value) + 1, Year(Me.First_ISP.Value))
     End If
'Calculating the date of the third ISP from the date of the second
     If Month(Me.Second_ISP.Value) = 12 Then
     Me.Third_ISP.Value = DayInMonth(3, vbFriday, 1, Year(Me.Second_ISP.Value) + 1)
     ElseIf Month(Me.Second_ISP.Value) < 12 Then
     Me.Third_ISP.Value = DayInMonth(3, vbFriday, Month(Me.Second_ISP.Value) + 1, Year(Me.Second_ISP.Value))
     End If
End Sub

I don't know if anyone else is interested in stuff like this but I was pretty happy when I got this working so hopefully it will help someone else too.

Ps. To avoid confusion all ISP terms refer to dates of payment for Internship Support Payments (hence ISP).

[pbaldy]

I would have avoided the testing by adding a month to the first date with DateAdd, then passing the month and year of the resulting date to the function. In any case, glad you have a working solution.