Calculate workdays
2008-09-18 Dates 1 252
With the custom functions below you can calculate the count of workdays between two dates. Workdays includes normal weekdays except Saturdays and Sundays or holidays e.g. like Easter).
The functions can be used like this in a worksheet cell:
=CountWorkDays(A1,B1) =AddWorkDays(A1,15) =DateIsHoliday(A1)
The date input cells must contain valid Excel dates, or formulas/functions that return dates, e.g. =TODAY().
Function CountWorkDays(StartDate As Long, EndDate As Long) As Long ' returns the workday count between two dates Dim d As Long, dCount As Long dCount = 0 If StartDate < 1 Or EndDate < 1 Then Exit Function If StartDate <= EndDate Then For d = StartDate To EndDate If Not DateIsHoliday(d) Then dCount = dCount + 1 End If Next d Else For d = StartDate To EndDate Step -1 If Not DateIsHoliday(d) Then dCount = dCount + 1 End If Next d End If CountWorkDays = dCount End Function Function AddWorkDays(StartDate As Long, Offset As Long) As Long ' returns a date Offset days from StartDate Dim d As Long, dCount As Long If StartDate < 1 Then Exit Function d = StartDate If Abs(Offset) > 0 Then dCount = 0 If Offset > 0 Then Do If Not DateIsHoliday(d) Then dCount = dCount + 1 End If d = d + 1 Loop Until dCount = Offset d = d - 1 Else Do If Not DateIsHoliday(d) Then dCount = dCount - 1 End If d = d - 1 Loop Until dCount = Offset d = d + 1 End If End If AddWorkDays = d End Function Function DateIsHoliday(InputDate As Long) As Boolean ' returns True if InputDate is a Saturday/Sunday or a holiday (Norwegian) Dim d As Integer, intYear As Integer, lngEasterSunday As Long, OK As Boolean OK = False If InputDate > 0 Then If Weekday(InputDate, vbMonday) >= 6 Then ' Saturday or Sunday OK = True End If If Not OK Then ' check if InputDate is a holiday intYear = Year(InputDate) d = (((255 - 11 * (intYear Mod 19)) - 21) Mod 30) + 21 lngEasterSunday = DateSerial(intYear, 3, 1) + d + (d > 48) + 6 - ((intYear + intYear \ 4 + d + (d > 48) + 1) Mod 7) OK = True Select Case InputDate Case CDate("1.1." & intYear) ' 1. January 'Case lngEasterSunday - 4 ' Wednesday before Easter Case lngEasterSunday - 3 ' Thursday before Easter Case lngEasterSunday - 2 ' Friday before Easter Case lngEasterSunday ' Easter Sunday Case lngEasterSunday + 1 ' Monday after Easter Case CDate("1.5." & intYear) ' 1. May Case CDate("17.5." & intYear) ' 17. May Case lngEasterSunday + 39 ' Ascension Day 'Case lngEasterSunday + 48 ' Pentecost Case lngEasterSunday + 49 ' Pentecost Case lngEasterSunday + 50 ' Pentecost 'Case CDate("24.12." & intYear) ' Christmas Case CDate("25.12." & intYear) ' Christmas Case CDate("26.12." & intYear) ' Christmas 'Case CDate("31.12." & intYear) ' New Years Eve Case Else OK = False End Select End If End If DateIsHoliday = OK End Function