Function to count time between to days with extras 1

[AppStaff]

Anyone done a custom function with these requirements
-draws from table listing non-work days
-provides option group to include or exclude weekends
-calculates the number of days between a start date and end date excluding the pre-defined dates and including/excluding weekends based on the option group selection.

If would be nice if it allowed for quick conversion between min, hours, days, weeks, etc

Anyone done anything like this? I know of a weekday function but I need something with more flexibility and was hoping I didnt have to reinvent the wheel.

 

[KenReay]

Hi

Try looking at:

http://www.mvps.org/access/datetime/index.htm

there are nay date/time and other goodies Regards

Ken Reay
Freelance Solutions Developer
Boldon Information Systems Ltd
UK

 

[MichaelRed]

faq181-261

or this rather minor variation

Public Function basWrkHrs(StDate As Date, EndDate As Date) As Double

    'Get the number of work HOURS between the given dates
    'Michael Red    8/23/01

    Dim blnHoliFnd As Boolean       'Flag for Hloiday found
    Dim Holidate(21) As Date        'Table of Holidays
    Dim Idx As Long                 'Index for start/end dates
    Dim Kdx As Long                 'Index / counter for Number of days
    Dim Jdx As Integer              'Index doe the Hloidate array
    Dim MyDate As Date              'Tempdate
    Dim AccumTime As Double         'Hours Accumulated

    Const MinsPerDay = 1440         'Every Minute of the DAY!!
    Const MinsPerHr = 60#           '60 Minutes per Hour

    'For MAINTENANCE purposes, the array should be in a TABLE
    'There SHOULD be a form to add/edit/delete the table.
    
    'At run time, the TABLE should be wholy loaded into the ARRAY
    'to promote execution effiency.

    'Array(Table) of Holiday Dates
    Holidate(0) = #1/1/2001#        'NewYearsDay
    Holidate(1) = #1/17/2001#       'Martin Luther King Day
    Holidate(2) = #2/2/2001#        'Groundhog Day
    Holidate(3) = #2/12/2001#       'Lincon's Birthday
    Holidate(4) = #2/14/2001#       'Valentine's Day
    Holidate(5) = #2/21/2001#       'President's Day
    Holidate(6) = #2/22/2001#       'Washington's Birthday
    Holidate(7) = #3/8/2001#        'Ash Wednesday
    Holidate(8) = #3/17/2001#       'St. Patrick's Day
    Holidate(8) = #4/1/2001#        'April Fool's Day
    Holidate(9) = #4/20/2001#       'Passover
    Holidate(10) = #4/21/2001#      'Good Friday
    Holidate(11) = #5/5/2001#       'Cinco de Mayo
    Holidate(12) = #5/14/2001#      'Mother's Day
    Holidate(13) = #6/11/2001#      'Pentecost
    Holidate(14) = #6/18/2001#      'Father's Day
    Holidate(15) = #7/4/2001#       'Independence Day
    Holidate(16) = #9/4/2001#       'Labor Day
    Holidate(17) = #10/31/2001#     'Halloween
    Holidate(18) = #11/11/2001#     'Vetran's Day
    Holidate(19) = #11/23/2001#     'Thanksgiving
    Holidate(20) = #12/25/2001#     'Christmas
    Holidate(21) = #12/31/2001#     'New Year's Eve


    'Get the incremental Minutes for the Start & End Dates
    If (Not (Weekday(StDate) = vbSaturday Or Weekday(StDate) = vbSunday)) Then
        AccumTime = DateDiff("n", StDate, Format(StDate + 1, "mm/dd/yy"))
    End If

    If (Not (Weekday(EndDate) = vbSaturday Or Weekday(EndDate) = Sunday)) Then
        AccumTime = AccumTime + DateDiff("n", Format(EndDate, "mm/dd/yy"), EndDate)
    End If

    MyDate = Format(StDate + 1, "Short Date")

    'Loop for each day INSIDE the interval
    For Idx = CLng(StDate + 1) To CLng(EndDate) - 1

        blnHoliFnd = False

        If (Weekday(MyDate) = vbSaturday Or Weekday(MyDate) = vbSunday) Then
            blnHoliFnd = True
            GoTo NoTime
        End If

        For Jdx = 0 To UBound(Holidate)

            If (Holidate(Jdx) = MyDate) Then
                blnHoliFnd = True
                Exit For
'             Else
'                Do Nothing, it is NOT a Workday
            End If

        Next Jdx

NoTime:

        'count WHOLE (Work) days
        If (blnHoliFnd = False) Then
            Kdx = Kdx + 1
        End If
    
        MyDate = DateAdd("d", 1, MyDate)
        

    Next Idx

    'Got the number of days.  Now, add work minutes to acuumtime
    AccumTime = AccumTime + CSng(Kdx) * CSng(MinsPerDay)

    basWrkHrs = AccumTime / MinsPerHr

End Function

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[AppStaff]

Wow thank you both for your replies.

Michael,

I have never used an access table to load an array could you provide code for that or show me in yours how that happens? Thanks again for your help!

 

[VBslammer]

Like this:

Function GetHolidays(ByRef datHolidays() As Date) As Boolean
On Error GoTo ErrHandler
  
  Dim rst As Recordset
  Dim db As Database
  Dim intCtr As Integer
  
  Set db = CurrentDb
  Set rst = db.OpenRecordset("Holidays", dbOpenTable)
  
  With rst
    .MoveLast
    .MoveFirst

    ReDim datHolidays(.RecordCount - 1)
    
    While Not .EOF
      datHolidays(intCtr) = .Fields("HolidayDate")
      intCtr = intCtr + 1
      .MoveNext
    Wend
    .Close
  End With
   
  GetHolidays = True
   
ExitHere:
  On Error Resume Next
  Set rst = Nothing
  Set db = Nothing
  Exit Function
ErrHandler:
  MsgBox Err & "-" & Err.Description
  Resume ExitHere
End Function

Call it like this:

  Dim Holidate() As Date
  Dim blnSuccess As Boolean

  blnSuccess = GetHolidays(Holidate())

  '...rest of code...

VBSlammer