Search Tools Links Login

DaysWorks


WorkingDays counts days except Weekends and Holidays

Original Author: eduardo Alvarez Bastida

Inputs

WorkingDays()

Assumptions

for call
x=WorkingDays("dd/mm/yy", "dd/mm/yy", xArray())
where xArray contents holidays "dd/mm"

Returns

integer WorkingDays

Code

Put this in a CommandButton
'
Dim aH(8)
aH(1) = "1/1"
aH(2) = "5/2"
aH(3) = "21/3"
aH(4) = "1/5"
aH(5) = "5/5"
aH(6) = "16/9"
aH(7) = "20/10"
aH(8) = "25/12"

debug.print = WorkingDays("01/01/00", "01/01/01", aH())
'

Public Function WorkingDays(dBeginDate As Date, dEndDate As Date, ByRef aHolidays As Variant) As Integer
  Dim intTotalDays As Integer
  Dim intHoliday As Integer
  Dim booWeekend As Boolean
  Dim intSatSun As Integer
  Dim strCDayMonth As String
  Dim strNDayMonth As String
  
  Dim i As Integer
  Dim dNewDate As Date
  If dBeginDate>=dEndDate then exit Function
  intTotalDays = DateDiff("d", dBeginDate, dEndDate)
  For i = 1 To intTotalDays
    dNewDate = DateAdd("d", i, dBeginDate)
    If isWeekEnd(dNewDate) Then
      booWeekend = True
    Else
      booWeekend = False
    End If
    
    strNDayMonth = Day(dNewDate) & "/" & Month(dNewDate)
    For n = 1 To UBound(aHolidays)
'      strMonth = Mid(aHolidays(h), istr("/", aHolidays(h)) + 1)
      If (strNDayMonth = aHolidays(n)) And Not booWeekend Then
        intHoliday = intHoliday + 1
        booWeekend = False
        Exit For
      End If
    Next n
    
    If booWeekend Then
      intSatSun = intSatSun + 1
    End If
    
  Next i
  
  WorkingDays = intTotalDays - intSatSun - intHoliday
End Function
Private Function isWeekEnd(ByRef dCheck As Date) As Boolean
  If DatePart("w", dCheck) = 1 Or DatePart("w", dCheck) = 7 Then isWeekEnd = True
End Function

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 85 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.