[AccessD] Calculating Time Cards

Jim Dettman jimdettman at earthlink.net
Fri Jun 20 05:23:22 CDT 2003


Julie,

  Here's how I do my time cards apps. Start/Stop times are kept as a numeric
number, along with a separate field for work date.  Generally the operators
like to key it in as hhmm.  Of course the other issues is 0005 five minutes
or half an hour?  You can do either with this technique.  I also allow for
adjustments where no start/stop time is entered, but simply an amount of
time.  I do this with a -1 in the start time control.  The code for the
Start time AfterUpdate event is below.

   The other issue when entering start/stop times is does the start/stop
range entered overlap another card already entered.  I've posted code below
for that as well.  This is done in the BeforeUpdate event of the start and
stop time control.

  The last thing you talked about is shift.  It's difficult to do in some
cases because what's considered "normal" for each employee may be difficult
to determine.  Over the years, I've settled for the technique of setting up
an employees work schedule, then flagging the time card as being "out of
shift" if it doesn't match up to the schedule.

  The schedule records have the following fields:

SchedDate
Mon
Tue
Wed
Thu
Fri
Sat
Sun
NoHours
Start
Stop

  The user can either indicate a specific date, or tick off the days of the
week that this should apply to.  If they tick no hours, it means the
employee should not be working at all.  Start/stop time indicates the normal
shift for the employee.

  I've included code for everything I've mentioned above.  May give you some
ideas.

HTH,
Jim Dettman
President,
Online Computer Services of WNY, Inc.
(315) 699-3443
jimdettman at earthlink.net


Private Sub txtStart_AfterUpdate()

  Dim dblStartTime As Double
  Dim dblStopTime As Double

  If Me![txtStart] = 0 Or IsNull(Me![txtStart]) Then
    ' Line with no ET on it.
    Me![txtStop] = 0
    Me![txtET] = 0
    Me![txtRegHrs] = 0
    Me![txtOTHTHrs] = 0
    Me![txtOTDTHrs] = 0

    Me![txtStop].Enabled = False
    Me![txtStop].Locked = True
    Me![txtRegHrs].Enabled = False
    Me![txtRegHrs].Locked = True
    Me![txtOTHTHrs].Enabled = False
    Me![txtOTHTHrs].Locked = True
    Me![txtOTDTHrs].Enabled = False
    Me![txtOTDTHrs].Locked = True
  ElseIf Me![txtStart] = -1 Then
    Me![txtStop] = ""
    Me![txtET] = 0
    Me![txtRegHrs] = 0
    Me![txtOTHTHrs] = 0
    Me![txtOTDTHrs] = 0

    Me![txtStop].Enabled = False
    Me![txtStop].Locked = True
    Me![txtRegHrs].Enabled = True
    Me![txtRegHrs].Locked = False
    Me![txtOTHTHrs].Enabled = True
    Me![txtOTHTHrs].Locked = False
    Me![txtOTDTHrs].Enabled = True
    Me![txtOTDTHrs].Locked = False
  Else
    ' Use for minutes expressed as part of an hour
    ' i.e. start/stop time of 6.33 is 6 hours, 20 minutes
    'dblStartTime = TimeSerial(Fix(Me![txtStart]), Round((Me![txtStart] -
Fix(Me![txtStart])) * 60, 0), 0)
    'If IsNull(Me![txtStop]) Then
    '  dblStopTime = 0
    'Else
    '  dblStopTime = TimeSerial(Fix(Me![txtStop]), Round((Me![txtStop] -
Fix(Me![txtStop])) * 60, 0), 0)
    'End If


    ' Use for minutes expressed as minutes
    ' i.e. start/stop time of 6.33 is 6 hours, 33 minutes
    If IsNull(Me![txtStart]) Then
      dblStartTime = 0
    Else
      dblStartTime = TimeSerial(Fix(Me![txtStart] / 100), Me![txtStart] -
(Fix(Me![txtStart] / 100) * 100), 0)
    End If

    If IsNull(Me![txtStop]) Then
      dblStopTime = 0
    Else
      dblStopTime = TimeSerial(Fix(Me![txtStop] / 100), Me![txtStop] -
(Fix(Me![txtStop] / 100) * 100), 0)
    End If


    ' Since we only track the "start date", we need to add
    ' 24 hours to the stop time to indicate that the end
    ' time fell into another day.
    If dblStopTime <= dblStartTime Then dblStopTime = dblStopTime + 1

    ' Calculate ET.
    Me![txtET] = Round(DateDiff("n", dblStartTime, dblStopTime) / 60, 2)
    Me![txtRegHrs] = Me![txtET]
    Me![txtOTHTHrs] = 0
    Me![txtOTDTHrs] = 0

    Me![txtStop].Enabled = True
    Me![txtStop].Locked = False
    Me![txtRegHrs].Enabled = True
    Me![txtRegHrs].Locked = False
    Me![txtOTHTHrs].Enabled = True
    Me![txtOTHTHrs].Locked = False
    Me![txtOTDTHrs].Enabled = True
    Me![txtOTDTHrs].Locked = False
  End If

End Sub

=========================

rivate Sub txtStart_BeforeUpdate(Cancel As Integer)

  Dim intHours As Integer
  Dim intMinutes As Integer

  If (Me![txtStart] <> 0) And (Me![txtStart] <> -1) Then

    ' Use for minutes expressed as part of an hour
    ' i.e. start/stop time of 6.33 is 6 hours, 20 minutes
    'If Me![txtStart] > 2399 Or Me![txtStart] < 0 Then
    'If Me![txtStart] > 2399 Or Me![txtStart] < 0 Then
    '  gstrMBTitle = "Time format error."
    '  gstrMBMsg = "Your start time is invalid - <0 or >2399."

    ' Use for minutes expressed as minutes
    ' i.e. start/stop time of 6.33 is 6 hours, 33 minutes
    intHours = Fix(Me![txtStart] / 100)
    intMinutes = Me![txtStart] - (Fix(Me![txtStart] / 100) * 100)

    If Me![txtStart] < 0 Or intMinutes > 59 Then
      gstrMBTitle = "Time format error."
      gstrMBMsg = "Your start time is invalid - Enter as hhmm."

      gintMBDef = MB_OK
      gintMBLog = False
      gintMBBeep = True
      Call DisplayMsgBox
      Cancel = True
      Me![txtStart].SelStart = 0
      Me![txtStart].SelLength = 255
    Else
      If (CheckForOverlap("B")) Then
        gstrMBTitle = "Time range error."
        gstrMBMsg = "Your start time is in another start/stop range."
        gintMBDef = MB_OK
        gintMBLog = False
        gintMBBeep = True
        Call DisplayMsgBox
        Cancel = True
        Me![txtStart].SelStart = 0
        Me![txtStart].SelLength = 255
      End If
    End If
  End If

End Sub

==================================

Private Function CheckForOverlap(strTime As String) As Integer

  Dim rst As Recordset
  Dim curStartTime As Currency
  Dim curStopTime As Currency
  Dim curRecordStartTime As Currency
  Dim curRecordStopTime As Currency
  Dim lngCurTranID As Long
  Dim fAtNewRecord As Integer

  ' Routine to check if new time entry overlaps an existing time card line.
  CheckForOverlap = False
  On Error Resume Next
  lngCurTranID = Me![TranID]
  fAtNewRecord = (Err = 3021)

  ' Get start and stop times for current line.
  curStartTime = ConvertNulls(Me![txtStart], "0")
  curStopTime = ConvertNulls(Me![txtStop], "0")
  If curStopTime <= curStartTime Then curStopTime = curStopTime + 2400


  ' Check all records in clone.
  Set rst = Me.RecordsetClone
  If rst.RecordCount > 0 Then
    rst.MoveLast
    Do Until rst.BOF
      If fAtNewRecord = False Then
        If lngCurTranID <> rst![TranID] Then
          If Not (ConvertNulls(rst![Start], "") = "") Then
            curRecordStartTime = ConvertNulls(rst![Start], "0")
            curRecordStopTime = ConvertNulls(rst![Stop], "0")
            If curRecordStopTime < curRecordStartTime Then curRecordStopTime
= curRecordStopTime + 2400
            ' Debug.Print curStartTime, curRecordStartTime
            ' Debug.Print curStopTime, curRecordStopTime
            If curRecordStartTime > 0 And curRecordStopTime > 0 Then
              If strTime = "B" Then
                If curStartTime >= curRecordStartTime And curStartTime <
curRecordStopTime Then
                  CheckForOverlap = True
                  Exit Do
                End If
                If curStopTime <> 2400 Then
                  If curStartTime < curRecordStartTime And curStopTime >
curRecordStartTime Then
                    CheckForOverlap = True
                    Exit Do
                  End If
                End If
              Else
                If curStartTime < curRecordStartTime And curStopTime >
curRecordStartTime Then
                  CheckForOverlap = True
                  Exit Do
                End If
              End If
            End If
          End If
        End If
      End If
      rst.MovePrevious
    Loop
  End If

  rst.Close
  Set rst = Nothing

End Function
==================================
Public Sub LoadEmpSchedule()

  Dim qrydef As QueryDef
  Dim prm As Parameter
  Dim rst As Recordset
  Dim intK As Integer

  Set qrydef = dbCurrent.QueryDefs("qryfrmTimeCardLoadEmpSched")
  For intK = 0 To qrydef.Parameters.Count - 1
    Set prm = qrydef.Parameters(intK)
    prm.Value = Eval(prm.Name)
  Next intK
  Set rst = qrydef.OpenRecordset()
  On Error Resume Next
  rst.MoveLast
  rst.MoveFirst

  Erase varSchedRecords
  If rst.RecordCount > 0 Then
    varSchedRecords = rst.GetRows(rst.RecordCount)
     lngUpperLimitofSchedRecs = UBound(varSchedRecords, 2)
   Else
   lngUpperLimitofSchedRecs = 0
  End If

  rst.Close
  Set rst = Nothing

End Sub
===================================
Public Function CheckOutOfSchedule(dtWorkDate As Date, curStartTime As
Currency, curStopTime As Currency) As Integer

  Dim intK As Integer
  Dim intFoundMatch As Integer
  Dim intDay As Integer

  ' Loop through schedule records checking if passed start/stop time
  ' is within a scheduled start/stop time.
  If lngUpperLimitofSchedRecs = 0 Then
    CheckOutOfSchedule = False
    Exit Function
  End If

  CheckOutOfSchedule = True
  If curStopTime <= curStartTime Then curStopTime = curStopTime + 2400

  ' Always check for specific dates first.
  ' If we hit a date that is where search date is > array date,
  ' or the date is null, then there is no match.
  intFoundMatch = False

  For intK = 0 To lngUpperLimitofSchedRecs
    If IsNull(varSchedRecords(0, intK)) Then
      ' Hit first entry that is not date specific. Quit loop.
      intK = lngUpperLimitofSchedRecs
    Else
      If dtWorkDate > varSchedRecords(0, intK) Then
        ' Hit entry with date that is < search date.  No date specific
        ' match can be found. Quit loop.
        intK = lngUpperLimitofSchedRecs
      Else
        intFoundMatch = True
        ' First check if day flagged for no hours.
        If varSchedRecords(8, intK) = True Then
          ' Day flagged for no hours
          CheckOutOfSchedule = True
          intK = lngUpperLimitofSchedRecs
        Else
          If curStartTime < varSchedRecords(9, intK) Or curStartTime >
varSchedRecords(10, intK) Or curStopTime < varSchedRecords(9, intK) Or
curStopTime > varSchedRecords(10, intK) Then
             ' times falls outside of scheduled time, go look for next one.
          Else
            ' Have a record where were OK.  Quit.
            CheckOutOfSchedule = False
            intK = lngUpperLimitofSchedRecs
          End If
        End If
      End If
    End If
  Next intK

  If intFoundMatch = True Then Exit Function

  ' Now check general days.
  intDay = WeekDay(dtWorkDate, vbMonday)
  For intK = lngUpperLimitofSchedRecs To 0 Step -1
    If Not IsNull(varSchedRecords(0, intK)) Then
      ' Hit first entry that is not date specific. Quit loop.
      intK = 0
    Else
      If varSchedRecords(intDay, intK) = False Then
        ' This sched rec does not apply to this day.
      Else
        intFoundMatch = True
        ' First check if day flagged for no hours.
        If varSchedRecords(8, intK) = True Then
          ' Day flagged for no hours
          CheckOutOfSchedule = True
          intK = 0
        Else
          If curStartTime < varSchedRecords(9, intK) Or curStartTime >
varSchedRecords(10, intK) Or curStopTime < varSchedRecords(9, intK) Or
curStopTime > varSchedRecords(10, intK) Then
             ' times falls outside of scheduled time, go look for next one.
          Else
            ' Have a record where were OK.  Quit.
            CheckOutOfSchedule = False
            intK = 0
          End If
        End If
      End If
    End If
  Next intK

  If intFoundMatch = False Then CheckOutOfSchedule = False

End Function




-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com]On Behalf Of Julie
Reardon-Taylor
Sent: Thursday, June 19, 2003 11:09 AM
To: accessd at databaseadvisors.com
Subject: [AccessD] Calculating Time Cards


Hi Everyone,

<<snip>>




More information about the AccessD mailing list