VBScript Calculate Working Business Days
After spending an hour searching for this I finally dsecided to just do it myself. It's not that there weren't Any solutions available, just none that did exactly what I wanted to the degree I wanted. And this code is Far from perfect, but does what I need now. The title of this post consists of the keywords I used to find something like what I came up with, based on Many Similar Examples, mostly in SQL. However, I don't want to implement this in SQL until I understand any potential performance hits.
You'll notice there's no date validation. I know, I suck. Although refined a bit I can tell just by looking this could be a lot better, but I've learned the hard way, a less than optimal temporary solution is better than none at all as long as it remains a temporary solution... which means I'll have to have an imporved version in a follow up post :p
'==================================================
'WRKDAYSBETWEEN
'
'Calculates number of working days (Mon-Fri) between 2 dates
'
'==================================================
Function WrkDaysBetween(dtStart, dtEnd)
totalDays = DateDiff("D", dtStart, dtEnd)
totalWeeks = DateDiff("W", dtStart, dtEnd)
'COUNT DAYS IN FIRST WEEK -WEEKENDS
Select Case WeekDay(dtStart)
Case vbMonday
daysFirstWeek = 5
Case vbTuesday
daysFirstWeek = 4
Case vbWednesday
daysFirstWeek = 3
Case vbThursday
daysFirstWeek = 2
Case vbFriday
daysFirstWeek = 1
Case vbSaturday
daysFirstWeek = 0
Case vbSunday
daysFirstWeek = 0
End Select
'COUNT DAYS IN END WEEK -WEEKENDS
Select Case WeekDay(dtEnd)
Case vbSaturday
daysLastWeek = 0
Case vbSunday
daysLastWeek = 0
Case vbMonday
daysLastWeek = 0
Case vbTuesday
daysLastWeek = 1
Case vbWednesday
daysLastWeek = 2
Case vbThursday
daysLastWeek = 3
Case vbFriday
daysLastWeek = 4
End Select
modDays = totalDays Mod 7
'GET DAYS OUTSIDE OF WEEKS
if modDays < daysFirstWeek + daysLastWeek then
oddDays = modDays
else
oddDays = daysFirstWeek + daysLastWeek
end if 'modDays < daysFirstWeek + daysLastWeek
if totalDays < daysFirstWeek then
wrkDays = totalDays + (totalWeeks * 5)
else
wrkDays = oddDays + (totalWeeks * 5)
end if 'totalDays < daysFirstWeek
WrkDaysBetween = wrkDays
End Function
'==================================================
Addendum: This link was NOT there yesterday. Damn ever changing web...
You'll notice there's no date validation. I know, I suck. Although refined a bit I can tell just by looking this could be a lot better, but I've learned the hard way, a less than optimal temporary solution is better than none at all as long as it remains a temporary solution... which means I'll have to have an imporved version in a follow up post :p
'==================================================
'WRKDAYSBETWEEN
'
'Calculates number of working days (Mon-Fri) between 2 dates
'
'==================================================
Function WrkDaysBetween(dtStart, dtEnd)
totalDays = DateDiff("D", dtStart, dtEnd)
totalWeeks = DateDiff("W", dtStart, dtEnd)
'COUNT DAYS IN FIRST WEEK -WEEKENDS
Select Case WeekDay(dtStart)
Case vbMonday
daysFirstWeek = 5
Case vbTuesday
daysFirstWeek = 4
Case vbWednesday
daysFirstWeek = 3
Case vbThursday
daysFirstWeek = 2
Case vbFriday
daysFirstWeek = 1
Case vbSaturday
daysFirstWeek = 0
Case vbSunday
daysFirstWeek = 0
End Select
'COUNT DAYS IN END WEEK -WEEKENDS
Select Case WeekDay(dtEnd)
Case vbSaturday
daysLastWeek = 0
Case vbSunday
daysLastWeek = 0
Case vbMonday
daysLastWeek = 0
Case vbTuesday
daysLastWeek = 1
Case vbWednesday
daysLastWeek = 2
Case vbThursday
daysLastWeek = 3
Case vbFriday
daysLastWeek = 4
End Select
modDays = totalDays Mod 7
'GET DAYS OUTSIDE OF WEEKS
if modDays < daysFirstWeek + daysLastWeek then
oddDays = modDays
else
oddDays = daysFirstWeek + daysLastWeek
end if 'modDays < daysFirstWeek + daysLastWeek
if totalDays < daysFirstWeek then
wrkDays = totalDays + (totalWeeks * 5)
else
wrkDays = oddDays + (totalWeeks * 5)
end if 'totalDays < daysFirstWeek
WrkDaysBetween = wrkDays
End Function
'==================================================
Addendum: This link was NOT there yesterday. Damn ever changing web...
Labels: programming
2 Comments:
Hey, Thanks! This helped a lot. :) I too found a few bits of code on the net. I tried one which looked like it would work, but didn't. I tried your function (tweaked a bit), & it worked perfectly. :) I needed it for vbscript behind a DAP in MS Access to calc turn around time - I wanted weekends excluded in the calc. :)
Hey man Thanks so much. It works perfectely. You rock!!!!
Post a Comment
<< Home