[AccessD] Calculating End of Month on a 4-4-5 Schedule

Gustav Brock Gustav at cactus.dk
Mon Oct 8 09:45:48 CDT 2007


Hi Joe

What a strange request. Where do you use such info?

Anyway, the first function below should get you started; loop through the months in question, and when a month with a count of five is found, check if the preceeding two months each have a count of four. If a full 4-4-5 match is located, retrieve the last date of the last month using the second function.

/gustav

Public Function WeekdaysOfMonth( _
  ByVal datDateOfMonth As Date, _
  Optional ByVal intWeekday As Integer) _
  As Long

' Calculate count of a weekday in a month
' which always is four or five.
'
' 2002-07-14. Cactus Data ApS, CPH.

  ' Minimum number of weeks for any month.
  Const clngCountWeekdayMin As Long = 4
  ' Number of days in a week.
  Const clngWeekdays        As Long = 7
  ' Specify default weekday.
  Const cintweekdayDefault  As Integer = vbSunday
  
  Dim datWeekday28th        As Date
  Dim datWeekdayLast        As Date
  Dim intWeekday28th        As Integer
  Dim intWeekdayLast        As Integer
  Dim intYear               As Integer
  Dim intMonth              As Integer
  Dim lngFive               As Long
  
  ' Validate intWeekday.
  Select Case intWeekday
    Case vbMonday, vbTuesday, vbWednesday, vbThursday, vbFriday, vbSaturday, vbSunday
      ' No change.
    Case Else
      ' Pick default weekday.
      intWeekday = cintweekdayDefault
  End Select

  intYear = Year(datDateOfMonth)
  intMonth = Month(datDateOfMonth)
  ' Dates of the 28th and the last of the month.
  datWeekday28th = DateSerial(intYear, intMonth, clngCountWeekdayMin * clngWeekdays)
  datWeekdayLast = DateSerial(intYear, intMonth + 1, 0)
  ' Weekdays of the 28th and the last of the month.
  intWeekday28th = WeekDay(datWeekday28th, vbSunday)
  intWeekdayLast = WeekDay(datWeekdayLast, vbSunday)
  
  ' Check if the weekday exists between the 28th and the last of the month.
  If intWeekday28th <= intWeekdayLast Then
    If intWeekday28th < intWeekday And intWeekday <= intWeekdayLast Then
      lngFive = 1
    End If
  Else
    If intWeekday28th < intWeekday Or intWeekday <= intWeekdayLast Then
      lngFive = 1
    End If
  End If
  
  WeekdaysOfMonth = clngCountWeekdayMin + lngFive

End Function


Public Function DateThisMonthLast( _
  Optional ByVal datDateThisMonth As Date) _
  As Date

  If datDateThisMonth = 0 Then
    datDateThisMonth = Date
  End If
  
  DateThisMonthLast = DateSerial(Year(datDateThisMonth), Month(datDateThisMonth) + 1, 0)

End Function



>>> JRojas at tnco-inc.com 08-10-2007 16:24 >>>
Hello,

I am trying to come up with a code snippet that will give me the last
date of the month on a 4-4-5 schedule.
A 4-4-5 schedule is when the first two months in a quarter end on the
fourth Saturday of the month and the 3rd month ends on the fifth
Saturday.

e.g.
Jan 07 - 1/27/2007
Feb 07 - 2/24/2007
Mar 07 - 3/31/2007

I can get these dates using brute force but I was looking to see if
there is an elegant way.

Joe Rojas
Information Technology Manager
Symmetry Medical TNCO
15 Colebrook Blvd
Whitman MA 02382
781.447.6661 x7506






More information about the AccessD mailing list