Access Ver 2.0 Adding days to a date to give target date excluding weekends?

M

Michael

Hi Everyone,

Not sure if i'm posting in the right spot so sorry if its not, please
direct me to the correct location :)

I have three fields in a form, [quote accepted], [days to results] and
[target date]. I need to calculate the target date by adding the [quote
accepted] and [days to results] together but i want to exclude the
weekends as [days to results] is only working days.

Example

Quote accepted date: 16/11/2006

Days to result: 20

Target Date: 14/12/2006

Also there can be time where the information will be missing so
therefore it will have to handle null values ect

I have no preference over code or macro, which ever is better for this
application.
 
M

missinglinq via AccessMonster.com

The best way to handle the missing info is to simply check the appropriate
fields and if one IsNull, not run the calculation. Microsoft realised
somewhere along the line that people thought that

DateAdd("w", intInterval, strDate) would add weekdays only, and, of course,
it doesn't! So they've posted a new function in the Knowledge Base, called
AddDateW().

Either open an existing module or invoke a new module, and copy and paste
this function into it:

'**************Function Code******************

'==========================================================
' The DateAddW() function provides a workday substitute
' for DateAdd("w", number, date). This function performs
' error checking and ignores fractional Interval values.
'==========================================================
Function DateAddW (ByVal TheDate, ByVal Interval)

Dim Weeks As Long, OddDays As Long, Temp As String

If VarType(TheDate) <> 7 Or VarType(Interval) < 2 Or _
VarType(Interval) > 5 Then
DateAddW = TheDate
ElseIf Interval = 0 Then
DateAddW = TheDate
ElseIf Interval > 0 Then
Interval = Int(Interval)

' Make sure TheDate is a workday (round down).

Temp = Format(TheDate, "ddd")
If Temp = "Sun" Then
TheDate = TheDate - 2
ElseIf Temp = "Sat" Then
TheDate = TheDate - 1
End If

' Calculate Weeks and OddDays.

Weeks = Int(Interval / 5)
OddDays = Interval - (Weeks * 5)
TheDate = TheDate + (Weeks * 7)

' Take OddDays weekend into account.

If (DatePart("w", TheDate) + OddDays) > 6 Then
TheDate = TheDate + OddDays + 2
Else
TheDate = TheDate + OddDays
End If

DateAddW = TheDate
Else ' Interval is < 0
Interval = Int(-Interval) ' Make positive & subtract later.

' Make sure TheDate is a workday (round up).

Temp = Format(TheDate, "ddd")
If Temp = "Sun" Then
TheDate = TheDate + 1
ElseIf Temp = "Sat" Then
TheDate = TheDate + 2
End If

' Calculate Weeks and OddDays.

Weeks = Int(Interval / 5)
OddDays = Interval - (Weeks * 5)
TheDate = TheDate - (Weeks * 7)

' Take OddDays weekend into account.

If (DatePart("w", TheDate) - OddDays) > 2 Then
TheDate = TheDate - OddDays - 2
Else
TheDate = TheDate - OddDays
End If

DateAddW = TheDate
End If

End Function

'***********End of Function Code**********

Then to invoke the function:

DateAddW([StartDate],interval)


So your code would look something like this:

'''Place your validation code here to make sure all info is present, if so

Me.[target date].value = DateAddW([quote accepted], [days to results])
 
M

Michael

Thank you so much for your help, much appreciated.

This will help me and my workplace keep a much more accrete record of
target dates...

Thanks once again

Best regards,
Michael Nilsen


The best way to handle the missing info is to simply check the appropriate
fields and if one IsNull, not run the calculation. Microsoft realised
somewhere along the line that people thought that

DateAdd("w", intInterval, strDate) would add weekdays only, and, of course,
it doesn't! So they've posted a new function in the Knowledge Base, called
AddDateW().

Either open an existing module or invoke a new module, and copy and paste
this function into it:

'**************Function Code******************

'==========================================================
' The DateAddW() function provides a workday substitute
' for DateAdd("w", number, date). This function performs
' error checking and ignores fractional Interval values.
'==========================================================
Function DateAddW (ByVal TheDate, ByVal Interval)

Dim Weeks As Long, OddDays As Long, Temp As String

If VarType(TheDate) <> 7 Or VarType(Interval) < 2 Or _
VarType(Interval) > 5 Then
DateAddW = TheDate
ElseIf Interval = 0 Then
DateAddW = TheDate
ElseIf Interval > 0 Then
Interval = Int(Interval)

' Make sure TheDate is a workday (round down).

Temp = Format(TheDate, "ddd")
If Temp = "Sun" Then
TheDate = TheDate - 2
ElseIf Temp = "Sat" Then
TheDate = TheDate - 1
End If

' Calculate Weeks and OddDays.

Weeks = Int(Interval / 5)
OddDays = Interval - (Weeks * 5)
TheDate = TheDate + (Weeks * 7)

' Take OddDays weekend into account.

If (DatePart("w", TheDate) + OddDays) > 6 Then
TheDate = TheDate + OddDays + 2
Else
TheDate = TheDate + OddDays
End If

DateAddW = TheDate
Else ' Interval is < 0
Interval = Int(-Interval) ' Make positive & subtract later.

' Make sure TheDate is a workday (round up).

Temp = Format(TheDate, "ddd")
If Temp = "Sun" Then
TheDate = TheDate + 1
ElseIf Temp = "Sat" Then
TheDate = TheDate + 2
End If

' Calculate Weeks and OddDays.

Weeks = Int(Interval / 5)
OddDays = Interval - (Weeks * 5)
TheDate = TheDate - (Weeks * 7)

' Take OddDays weekend into account.

If (DatePart("w", TheDate) - OddDays) > 2 Then
TheDate = TheDate - OddDays - 2
Else
TheDate = TheDate - OddDays
End If

DateAddW = TheDate
End If

End Function

'***********End of Function Code**********

Then to invoke the function:

DateAddW([StartDate],interval)


So your code would look something like this:

'''Place your validation code here to make sure all info is present, if so

Me.[target date].value = DateAddW([quote accepted], [days to results])
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top