3 work days prior to 18th

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Joker - 12 Feb 2007 16:43 GMT

Hello,

I have an odd request from work which is giving me quite a bit of trouble. I
need to figure out the 3rd Business day prior to the 18 in VBA. I have been
trying to manipulate the code "GetBusinessDay" by Arvin Meyer to no success
(below). Just a FYI.. This is going to be used in a user defined function.
Any help/thoughts will be GREATLY appreciated. Thanks.

Function GetBusinessDay(datStart As Date, intDayAdd As Variant)
On Error GoTo Error_Handler
'Adds/Subtracts the proper Business day skipping holidays and weekends
'Requires a table (tblHolidays) with a date field (HolidayDate)
'Arvin Meyer 05/26/98 revised 3/12/2002
'© Arvin Meyer 1998 - 2002 You may use this code in your application provided
author
' is given credit. This code may not be distributed as part of a collection
' without prior written permission. This header must remain intact.

Dim rst As DAO.Recordset
Dim DB As DAO.Database
'Dim strSQL As String

Set DB = CurrentDb
Set rst = DB.OpenRecordset("SELECT [HolidayDate] FROM tblHolidays",
dbOpenSnapshot)

If intDayAdd > 0 Then
Do While intDayAdd > 0
datStart = datStart + 1
rst.FindFirst "[HolidayDate] = #" & datStart & "#"
If Weekday(datStart) <> vbSunday And Weekday(datStart) <> vbSaturday
Then
If rst.NoMatch Then intDayAdd = intDayAdd - 1
End If
Loop

ElseIf intDayAdd < 0 Then

Do While intDayAdd < 0
datStart = datStart - 1
rst.FindFirst "[HolidayDate] = #" & datStart & "#"
If Weekday(datStart) <> vbSunday And Weekday(datStart) <> vbSaturday
Then
If rst.NoMatch Then intDayAdd = intDayAdd + 1
End If
Loop

End If

GetBusinessDay = datStart

Exit_Here:
rst.Close
Set rst = Nothing
Set DB = Nothing
Exit Function

Error_Handler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Here
End Function

Reply to this Message

raskew - 12 Feb 2007 17:24 GMT

Hi-

Try copying this to a module, then call it per the instructions, e.g.
'? upbusdays3(#2/18/07#,3,False)
'2/14/07

Function UpBusDays3(pStart As Date, _
pnum As Integer, _
Optional pAdd As Boolean = True) As Date
'*******************************************
'Purpose: Add or subtract business days
' from a date
'Coded by: raskew
'Inputs: +) ? UpBusDays3(#2/17/06#, 3, True)
' -) ? UpBusDays3(#2/22/06#, 3, False)
'Output: +) 2/22/06
' -) 2/17/06
'*******************************************

Dim dteHold As Date
Dim I As Integer
Dim n As Integer

dteHold = pStart
n = pnum
For I = 1 To n
If pAdd Then 'add days
dteHold = dteHold + IIf(WeekDay(dteHold) > 5, 9 - WeekDay(dteHold),
1)
Else 'subtract days
'this isn't working for Sunday
dteHold = dteHold - IIf(WeekDay(dteHold) < 3, Choose(WeekDay
(dteHold), 2, 3), 1)
End If
Next I
UpBusDays3 = dteHold

End Function

HTH - Bob

>Hello,
>
[quoted text clipped - 57 lines]
> Resume Exit_Here
>End Function

Reply to this Message

steinmetzw42 - 12 Feb 2007 18:15 GMT

It worked Great raskew! Thank you!!!

>Hi-
>
[quoted text clipped - 41 lines]
>> Resume Exit_Here
>>End Function

Reply to this Message

Joker - 25 May 2007 15:40 GMT

Hello,

When using this here I'm always getting the date of the 13th of current month.
I'm not sure why. Regaurdless how you look at it subtracting 3 business days
from the 18th would not equal the 13th. Any thoughts would be greatly
appreciated. Thanks.

'Procdt is the processing date
'Goto Batcave exits the sub

THREEBD18TH:
If Day(18) > pDays Then 'Is the day that it should be remitted already
past for this month? If so go to next month
fncDueDate = DateAdd("m", 1, Procdt) 'add one month
fncDueDate = Procdt
fncDueDate = DateSerial(Year(fncDueDate), Month([fncDueDate]), Day(18) + 1)
'set the date static
fncDueDate = UpBusDays3(fncDueDate, 3, False)
GoTo Batcave
'fncDueDate = UpBusDays3(DateSerial(Year(fncDueDate), Month([fncDueDate]),
Day(18) + 1), 3, False)
Else
fncDueDate = Procdt
fncDueDate = DateSerial(Year(fncDueDate), Month([fncDueDate]), Day(18) + 1)
'set the date static
fncDueDate = UpBusDays3(fncDueDate, 3, False)
End If

Function UpBusDays3(pStart As Date, _
pnum As Integer, _
Optional pAdd As Boolean = False) As Date
''*******************************************
'Purpose: Add or subtract business days
' from a date
'Coded by: raskew
'Inputs: +) ? UpBusDays3(#2/17/06#, 3, True)
' -) ? UpBusDays3(#2/22/06#, 3, False)
'Output: +) 2/22/06
' -) 2/17/06
'*******************************************

Dim dteHold As Date
Dim I As Integer
Dim n As Integer

dteHold = pStart
n = pnum
For I = 1 To n
If pAdd Then 'add days
dteHold = dteHold + IIF(Weekday(dteHold) > 5, 9 - Weekday(dteHold),
1)
Else 'subtract days
'this isn't working for Sunday

dteHold = dteHold - IIF(Weekday(dteHold) = 1 Or 7, 6, dteHold)
'dteHold = dteHold - IIF(Weekday(dteHold) < 3, Choose(Weekday
(dteHold), 2, 3), 1)
End If
Next I
UpBusDays3 = dteHold

End Function

Reply to this Message

Joker - 29 May 2007 21:25 GMT

Hello,

Would anyone have any ideas on this? I am still struggling on this. Thanks.

Reply to this Message