A DateAdd Function that adds (x) amount of Working days

[ArffMarine]

I have read two seperate FAQ's on this subject (faq702-4851 and faq181-261). Neither one seems to fit what I want to do and if they do, I don't know how to apply them.

We have a 64-day course that is broken into six blocks of instruction. What I want to do is enter the start date of Block I and have the form automatically fill in the start and end dates for each subsequent block. On my form "ClassInformation" I have 10 fields:

blockIStart
BlockIIGrad
BlockIIIStart
BlockIIIGrad
BlockIVStart
BlockIVGrad
BlockVStart
BlockVGrad
BlockVIStart
BlockVIGrad

Blocks I & II are taught by the same instructor so calculating the 14 days as one block makes for shorter code.

The Blocks Vary in length
Blocks I & II toatal 14 days

Block II is 18
Block IV is 16
Block V is 7
Block VI is 14

I also would like to factor in holidays. for this I have a table "Holidays" with two fields:

holidate (Stores the date)
holiname (Stores the name)

I hope I have posted sufficient information. Thank you

ARFF Marine

 

[hwkranger]

You'll probably need to write a class for this. I can post something that will guide you, but - if you don't know VBA then you'll have trouble modifying my code to suit your needs

Randall Vollen
National City Bank Corp.

 

[mustangcoupe]

I used the code in the FAQ181-261

I entered the 1st date in a field and then off the first date I add the # of dats I want to it (ex. start date + X = end date) then I pass these two days in to the delta days function (from FAQ) and come back with a number of days not including working days and holidays. If this is equal to the # of days I wanted then all is OK and I use that end date else I add 1 day to the end date and go back to the delta days function.

Public Sub SETDUEDATE()
Dim Y As Date
Dim X As Integer
Dim intReturn As Integer
   On Error GoTo SETDUEDATE_Error

intReturn = IsSomethingInControl(Me.Compdate)
If intReturn = False Then
   Me.DueDate = ""
Else
Y = DateAdd("d", 11, Me.Compdate)
DATE1:
X = DeltaDays(Me.Compdate, Y)
If X = 11 Then
Me.DueDate = Y
Else
Y = DateAdd("d", 1, Y)
GoTo DATE1
End If
End If

   On Error GoTo 0
   Exit Sub

SETDUEDATE_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure SETDUEDATE of VBA Document Form_job_form"
End Sub

--Todd


TechnicalUser pretending to be a programmer(shhh… the boss doesn’t know yet)

 

[hwkranger]

Here's a class for your blocks. Save it as a CLASS MODULE. Goto INSERT CLASS MODULE from your code window and insert this code. Save as CLSBLOCK

Option Compare Database
Option Explicit

Private str_BlockName As String
Private lng_BlockNumber As Long
Private lng_BlockLength As Long
Private dt_BlockStart As Date
Private dt_BlockEnd As Date
Private str_HolidayTable As String
Private str_HolidayField As String

Public Function Init()
If ValidateBlock Then
Call fSetEndDate
End If
End Function

Private Function fSetEndDate()
On Error Resume Next
Dim i As Integer
Dim dt_TempDate As Date

dt_TempDate = dt_BlockStart

For i = 1 To lng_BlockLength
dt_TempDate = DateAdd("d", 1, dt_TempDate)
'subtract weekends
If Format(dt_TempDate, "dddd") = "Sunday" Or Format(dt_TempDate, "dddd") = "Saturday" Then
i = i - 1
End If
'subtract holidays
If (Len(str_HolidayTable) + Len(str_HolidayField)) > 0 Then
Dim rst As New ADODB.Recordset
rst.Open "Select " & str_HolidayField & " from " & str_HolidayTable & " where " & str_HolidayField & " = #" & dt_TempDate & "#", CurrentProject.Connection, adOpenKeyset, adLockReadOnly
If rst.RecordCount Then
i = i - 1
End If
rst.Close
Set rst = Nothing
End If

Next i

dt_BlockEnd = dt_TempDate
End Function

Private Function ValidateBlock() As Boolean
If (lng_BlockNumber <> 0) And (lng_BlockLength > 0) And (dt_BlockStart <> "12:00:00 AM") Then
ValidateBlock = vbTrue
Else
ValidateBlock = vbFalse
End If
End Function

'Allows you to set a holiday table name
Public Sub SetHolidayTable(str_TableName As String, str_FieldName As String)
str_HolidayTable = str_TableName
str_HolidayField = str_FieldName
End Sub
'Allows you to set a holiday field name


'get, set block number
Public Property Get BlockNumber() As Long
BlockNumber = lng_BlockNumber
End Property

Public Property Let BlockNumber(lng_Number As Long)
lng_BlockNumber = lng_Number
End Property

'set block length
Public Property Let BlockLength(lng_Length As Long)
lng_BlockLength = lng_Length
End Property

'return block end date
Public Property Get BlockEnd() As Date
BlockEnd = dt_BlockEnd
End Property

'get, set block start date
Public Property Let BlockStart(dt_Start As Date)
dt_BlockStart = dt_Start
End Property

Public Property Get BlockStart() As Date
BlockStart = dt_BlockStart
End Property

'get set block name
Public Property Let BlockName(str_Name As String)
str_BlockName = str_Name
End Property

Public Property Get BlockName() As String
BlockName = str_BlockName
End Property


Randall Vollen
National City Bank Corp.

 

[hwkranger]

The following will give you a bunch of msg boxes showing the end dates. The class is very basic, no error handling was put in. But this will allow you to create each block separately, or use them anytime with anysize.

public function asdfasdf()

Dim block As New clsBlock

'block.SetHolidayTable "Holiday", "HolidayName"

block.BlockLength = 7
block.BlockNumber = 1
block.BlockStart = "10/01/04"
block.Init

MsgBox (block.BlockEnd)

block.BlockLength = 7
block.BlockNumber = 2
block.BlockStart = block.BlockEnd
block.Init
MsgBox (block.BlockEnd)

block.BlockLength = 18
block.BlockNumber = 3
block.BlockStart = block.BlockEnd
block.Init
MsgBox (block.BlockEnd)

block.BlockLength = 16
block.BlockNumber = 4
block.BlockStart = block.BlockEnd
block.Init
MsgBox (block.BlockEnd)

block.BlockLength = 7
block.BlockNumber = 5
block.BlockStart = block.BlockEnd
block.Init
MsgBox (block.BlockEnd)

block.BlockLength = 14
block.BlockNumber = 6
block.BlockStart = block.BlockEnd
block.Init
MsgBox (block.BlockEnd)

end function

Randall Vollen
National City Bank Corp.

 

[ArffMarine]

Thank you for your replies. The problem I am having is figuring out how to get the date entered to pass through this module. Could you give me an exapmle of an AfterUpdate event for my field? It is a txtbox named:BlockIStartDate

Thanks again.

ARFF Marine

 

[hwkranger]

The event after update on BlockIStartDate.

'I dont' remember what the exact afterupdate Subname looks like
Sub BlockIStartDate_AfterUpdate()
Dim block As New clsBlock
block.length = 7 'This is the length of your block 1
block.blockstart = me.BlockIStartDate 'this is the start date

'if you have a holiday table w/field
'block.setholidaytable("TableName", "FieldName")

'now we return your end date.
'Where are you storing or displaying the end date?
me.[Where Ever you want to display the data] = block.End
End Sub

Randall Vollen
National City Bank Corp.