Thursday, February 16, 2006

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...

Labels:

2 Comments:

Blogger PammiePi said...

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. :)

Tuesday, October 30, 2007 1:24:00 PM  
Anonymous Anonymous said...

Hey man Thanks so much. It works perfectely. You rock!!!!

Tuesday, December 16, 2008 8:52:00 AM  

Post a Comment

<< Home