Subtract Weekend Days

[Drew]

Wrote this for the same problem a couple postings above
yours. This works for any number of days in advance. It
will also take out the weekend days if the OrigDate is a
weekend date (ie - starts count as of Monday). You can
copy the code into a Module, making it Public, and then
turn it into a Function which would return your Date. If
you need help with that write me and let me know.

Here is a simple way to calc the date you are looking
for. As I said before, use the DateAdd Function. I have
two engineering degrees and the math formulas presented
in the other postings are quite extraordinary but far to
complex for this simple problem. Also, the previous
postings do not consider an ending date of Sat or Sunday
and calc wrong if the day starts on a Sat or Sun. THis
code will allow you to use any number of "weekday"
additions and will give you the correct business day for
the DateDue.

Here is the code:

Private Sub btn_AddDays_Click()
'This assumes that the 10 day count starts on the next
day.
'ie-Sunday start
'Day 1 Is monday
'2 is tues
'3 is wed
'4 is thurs
'5 is friday
'6 is monday
'and so on...

Dim NoD As Long 'Number of weekdays to add
Dim NoWD As Long 'Number of weekend days in number
Dim DateOut As Date 'This is the Input AcTextBox
Dim DateOutDay As Long 'This is the day of the week of
the DateOut
Dim DateDue As Date 'This Where the Date Due will be
displayed
Dim DateValue As Long 'Variable to use to test day of week

DateOut = Me.txtDateOut
NoD = Me.txtNumberofDaysToAdd
DateOutDay = Weekday(DateOut, vbSunday)

If DateOutDay = 1 Then
NoWD = (Round(NoD / 5, 0) * 2) - 2 'This accounts for
the Sunday Start
ElseIf DateOutDay = 7 Then
NoWD = (Round(NoD / 5, 0) * 2) - 1 'This accounts for
the Saturday Start
Else
NoWD = Round(NoD / 5, 0) * 2 'This is for all other
weekday Starts
End If

DateDue = DateAdd("d", NoD + NoWD, DateOut)
DateValue = Weekday(DateDue, vbSunday)

'Test to see if Date Due is falling on Weekday, if not
add the correct number of days
If DateValue = 7 Then
DateDue = DateAdd("d", 2, DateDue) 'IF the last day
falls on a Saturday then add two days to make the next
business day (Monday)
ElseIf DateValue = 1 Then
DateDue = DateAdd("d", 1, DateDue) 'IF the last day
falls on a Sunday then add one day to make the next
business day (Monday)
End If

Me.txtDateDue = DateDue

End Sub


Drew
"We are the programmers that dont do anything ...."