asked on

Access VBA for 4 on 4 off leave calendar

I am a firefighter and work a 4 days on 4 days of roster. I have found a great Access database for planning and managing leave. Only problem is it compiles the leave data for staff based on monday to friday - "If Weekday(MyDate, vbMonday) - 1 < 5" in below code. What code could I substitute here to select days on a 4 on 4 off basis?

For d = 1 To 31
If d > LastDayOfMonth Then
Temp = "-"
Else
MyDate = DateSerial(2000 + MyYear, m, d)
    If Weekday(MyDate, vbMonday) - 1 < 5 Then
    LData.MoveFirst
    Temp = "."
    Do While Not LData.EOF
        If LUsers!uinits = LData!LInits Then
            If MyDate >= LData!LDateFrom And MyDate <= LData!LDateTo Then
            Temp = LData!LType
            Exit Do
            End If
        End If
   LData.MoveNext
    Loop
    Else
    Temp = "."
    End If
End If

Open in new window

Tompa99

Hi,

If Weekday(MyDate, vbMonday) - 1 < 5 Then

If Weekday(MyDate, vbMonday) - 1 < 4 Then

Then it will be from Monday to Thursday I think.

Best Regards Tompa

ASKER CERTIFIED SOLUTION

lludden

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Gustav Brock

You need something like that for the Swedish 3-3-System and its numbering method for the 3-days-work and 3-days-off periods crossing the normal 7-day week boundaries as well as calendar years.

Thus, first of all, a fixed date that marks the beginning of the sequences.
Then, modification of the code below from a 3-3 sequence to a 4-4 sequence. Should be easy, but if you need assistance, please tell.

/gustav

Option Compare Database
Option Explicit

' 3-3-System methods.
' 2000-01-22. Cactus Data ApS, CPH.
  
  ' First date of the 3-3-system is by definition Monday 1998-04-06.
  Private Const pdatThreeThreeCyclusPrimo     As Date = #4/6/1998#
  ' Length of the 3-3-system cyclus by definition.
  Private Const plngThreeThreeCyclusLength    As Long = 6
  ' Value of the 3-3-system cyclus' first day, numeric: 1.
  Private Const plngThreeThreeCyclusFirstNum  As Long = 1
  ' Value of the 3-3-system cyclus' first day, alpha: "A".
  Private Const plngThreeThreeCyclusFirstChr  As Long = &H41
'

Public Function ThreeThreeCyclusDay( _
  ByVal datDate As Date, _
  Optional booChar As Boolean) As Long

  Dim lngThreeThreeCyclusDay          As Long
  Dim lngThreeThreeCyclusDayFirstVal  As Long
  
  If booChar = True Then
    lngThreeThreeCyclusDayFirstVal = plngThreeThreeCyclusFirstChr
  Else
    lngThreeThreeCyclusDayFirstVal = plngThreeThreeCyclusFirstNum
  End If
  lngThreeThreeCyclusDay = DateDiff("d", pdatThreeThreeCyclusPrimo, datDate) Mod plngThreeThreeCyclusLength
  
  ThreeThreeCyclusDay = lngThreeThreeCyclusDayFirstVal + lngThreeThreeCyclusDay
  
End Function

Public Function ThreeThreeCyclusDayChr( _
  ByVal datDate As Date) As String
  
  Dim strThreeThreeCyclusDayChr As String * 1
  
  strThreeThreeCyclusDayChr = Chr(ThreeThreeCyclusDay(datDate, True))
  
  ThreeThreeCyclusDayChr = strThreeThreeCyclusDayChr

End Function