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

Thanks for the functions!

Some public companies use this pattern for their "end of months".
I don't know the logic behind it...I just know I need to make my app
work with it. :)

If you look at a calendar, Jan, Feb, Apr, May, Jul, Aug, Oct, and Nov
only have 4 Saturdays and the others have 5 Saturdays.
The rational must be buried in that fact.

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


-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Gustav Brock
Sent: Monday, October 08, 2007 10:46 AM
To: accessd at databaseadvisors.com
Subject: Re: [AccessD] Calculating End of Month on a 4-4-5 Schedule

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



-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com