Results 1 to 3 of 3
  1. #1
    johnw
    Guest

    Calculating work days

    I have a database whereby a user enters the onhire and offhire dates, I would like to calculate the number of working days (Monday - Friday). Any ideas?

  2. #2
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Indianapolis, Indiana, USA
    Posts
    1,862
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculating work days

    Hi John, try this:<pre>Function CountWeekdays(StartDate As Date, StopDate As Date, IncludeStartDate As Boolean) As Integer
    'By: Mark Johnston 5/18/2001 Markjsc@yahoo.com
    'Inputs: StartDate and StopDate as Dates
    'Returns: Integer with counted number of weekdays (Monday through Friday)

    Dim Counter As Date
    Dim intLength As Integer
    Dim intCounter As Integer
    Counter = StartDate
    intCounter = 0

    Do Until Counter > StopDate
    If WeekDay(Counter) = 1 Then 'Sunday
    Counter = DateAdd("d", 1, Counter)
    ElseIf WeekDay(Counter) = 7 Then 'Saturday
    Counter = DateAdd("d", 2, Counter)
    Else 'Monday through Friday
    Counter = DateAdd("d", 1, Counter)
    intCounter = intCounter + 1
    End If
    Loop

    If IncludeStartDate = True Then
    CountWeekdays = intCounter 'Includes the StartDate
    Else
    CountWeekdays = intCounter - 1 'Does NOT include the StartDate
    End If
    End Function</pre>

    (I'm sure there's a better way to do it, but this seems to work pretty well.) <img src=/S/thumbup.gif border=0 alt=thumbup width=15 height=15>

  3. #3
    3 Star Lounger
    Join Date
    Feb 2001
    Location
    NYC,USA,Earth
    Posts
    273
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculating work days

    Here's something from another forum. It checks for holidays also using a table of holiday dates.

    Public Function WeekdaysMinusHolidays(BegDate, EndDate) As Long

    ' From Kristi at the ZDJournals Forum
    ' <A target="_blank" HREF=http://bbs.zdjournals.com/>http://bbs.zdjournals.com/</A>
    ' Returns the number of workdays
    ' between BegDate and EndDate. Returns
    ' 0 for weekends.
    '
    ' In:
    ' BegDate: First date in range.
    ' EndDate: Last date in range.
    ' Out:
    ' WeekdaysMinusHolidays: Long number of weekdays.
    ' History:
    ' Created 04/11/2000 JPK; Last Modified

    On Local Error GoTo ErrorHandler

    Dim strMsg As String ' for error handling
    Dim db As DATABASE
    Dim holidays As Recordset

    Dim d As Long
    Dim answer As Long
    Dim strCriteria As String

    ' Check for Nulls.
    If IsNull(BegDate) Or IsNull(EndDate) Then
    WeekdaysMinusHolidays = 0
    Exit Function
    End If

    Set db = CurrentDb
    Set holidays = db.OpenRecordset("tblholiday", dbOpenDynaset)
    ' Use this statement for non-linked tables.
    ' holidays.Index = "PrimaryKey"

    answer = 0

    'pick one:
    For d = BegDate To EndDate 'includes both end points
    'For d = BegDate + 1 To EndDate 'excludes BegDate
    'For d = BegDate To EndDate - 1 'excludes EndDate
    'For d = BegDate + 1 To EndDate - 1 'excludes both end points

    If WeekDay(d) <> 1 And WeekDay(d) <> 7 Then 'if not a weekend
    ' Use this for non-linked tables.
    ' holidays.Seek "=", d
    ' Remark the following two lines
    ' for non-linked tables.
    strCriteria = "HOLIDATE = " & d
    holidays.FindFirst strCriteria
    If holidays.NOMATCH Then 'not a holiday
    answer = answer + 1
    End If
    End If
    Next d

    holidays.Close
    db.Close

    WeekdaysMinusHolidays = answer

    ExitProc:
    Exit Function

    ErrorHandler:
    Select Case Err
    Case Else
    strMsg = "Error Information..." & vbCrLf & vbCrLf
    strMsg = strMsg & "Function: WeekdaysMinusHolidays" & vbCrLf
    strMsg = strMsg & "Description: " & Err.Description & vbCrLf
    strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
    MsgBox strMsg, vbInformation, "WeekdaysMinusHolidays"
    Resume ExitProc
    End Select

    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •