asked on

VBA for calculation of dates and showing a warning etc.

I hope I can get a quick answer to why my code is not working. To give you the back ground in my database application, I need to take a date field and a data size gb fields to determine how quickly to process the data in business days.

So for example, I have the following fields:

Data_Size_GB as Double
Date_Received as Date
Expected_Delivery as Date
SLA_Expectation As Text
SLA_Status As Text

We have a specialized software for the legal industry so we can get native files such as emails, word, excel, etc. so this access db is tracking all of the vital information that we have to report back to our client on a weekly basis. So we fill-out our database form with the Date Received (when we receive the new data load request), Data Size (GB) based on these two fields, we need to determine how many business days, it will take us to complete the dataload per the client's SLA (expectations).

So, if I get a dataload today 09/10/2012 and it is 5.00 GB then I would need to add 3 days to Date_Received to update the Expected_Delivery field of when it is due and I have the SLA_Expectation would fill in with the particular SLA that meets the data and date received fields = Three (3) work-days after receipt of the media. The SLA_Status will be based on whether we Beat, Meet or Fail the 3 days that compares the Expected_Delivery field with the Date_Available field. When calculating the Expected Delivery, we need to make sure that we do not count any weekends and holidays since it is business days.

Here is my code so far:

Private Sub Expected_Delivery_AfterUpdate()

Dim dataSizeGB As Double
Dim dueDate As Date

Me.Data_Size_GB = dataSizeGB

If (dataSizeGB < 1) Then
dueDate = DateSerial(Month([Date_Received]), Day([Date_Received] + 1), Year([Date_Received]))
dueDate = Me.Expected_Delivery
ElseIf (dataSizeGB > 1 < 5) Then
dueDate = DateSerial(Month([Date_Received]), Day([Date_Received] + 3), Year([Date_Received]))
dueDate = Me.Expected_Delivery
ElseIf (dataSizeGB > 5 < 20) Then
dueDate = DateSerial(Month([Date_Received]), Day([Date_Received] + 5), Year([Date_Received]))
dueDate = Me.Expected_Delivery
ElseIf (dataSizeGB > 20 < 100) Then
dueDate = DateSerial(Month([Date_Received]), Day([Date_Received] + 8), Year([Date_Received]))
dueDate = Me.Expected_Delivery
ElseIf (dataSizeGB > 100 < 300) Then
dueDate = DateSerial(Month([Date_Received]), Day([Date_Received] + 15), Year([Date_Received]))
dueDate = Me.Expected_Delivery
ElseIf (dataSizeGB > 300) Then
MsgBox "Please contact the SEC POC and Enter Expected Delivery Date", vbOKOnly
End If

End Sub

I really need help. Thanks.

Rey Obrero (Capricorn1)

use this format for calculating the due date

dueDate = DateSerial(Year([Date_Received]), Month([Date_Received]), Day([Date_Received] + 1))

lauriecking0623

ASKER

@capricorn1

I made the change; however, it still does not update the Expected_Delivery Date yet.

Plus I want it to use the business days as well. I have a function for calculating the business days that I can use.

Rey Obrero (Capricorn1)

use

Private Sub Date_Received_AfterUpdate()

event to update the Expected_Delivery Date

instead of

Private Sub Expected_Delivery_AfterUpdate()

Private Sub Date_Received_AfterUpdate()

Dim dataSizeGB As Double
Dim dueDate As Date

Me.Data_Size_GB = dataSizeGB

If (dataSizeGB < 1) Then
dueDate = DateSerial(Year([Date_Received]), Month([Date_Received]), Day([Date_Received] + 1))

' all the other conditions here

end if

me.Expected_Delivery=dueDate

end sub

lauriecking0623

ASKER

It will give me the calculated date; however, when I have more than 1 GB entered, it still adds only one day even those it is over 1.5 so it should add 3 business days.

How could I add the business days? I have a function but I am not sure how to incorporate it in this code?

Here is the code:

Option Compare Database
Option Explicit

Function Work_Days(BegDate As Variant, EndDate As Variant) As Integer

'"Calculating the workdays between Dates"
'Note that this function does account for holidays

Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer

BegDate = DateValue(BegDate)
EndDate = DateValue(EndDate)
DateCnt = BegDate
EndDays = 0

Do While DateCnt <= EndDate

If Not IsNull(DLookup("Holiday_Date", "TBL_Holidays", "[Holiday_Date]=#" & DateCnt & "#")) Then
EndDays = EndDays - 1
End If

If Format(DateCnt, "ddd") <> "Sun" And _
Format(DateCnt, "ddd") <> "Sat" Then
EndDays = EndDays + 1
DateCnt = DateAdd("d", 1, DateCnt)
Loop
Work_Days = EndDays

End Function

ASKER CERTIFIED SOLUTION

Gustav Brock

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

lauriecking0623

ASKER

@cactus_data,

That works. I would like to make sure not to include the weekend days and holidays. I have the holidays in a table. I have posted my function above. What is your suggestion?

Rey Obrero (Capricorn1)

<it still adds only one day even those it is over 1.5 so it should add 3 business days.>

If (dataSizeGB < 1) Then
dueDate = DateSerial(Year([Date_Received]), Month([Date_Received]), Day([Date_Received] + 1))

' all the other conditions here '<<did you read this part

end if

lauriecking0623

ASKER

@capricorn1,

yes, I put the other conditions into my code. It did not work for some reason. I think that the Select...Case works the best since it works.

@cactus_data:

I changed it to the Select Case. It works great just need to be able to put in my code that I created for work days so when the calculation is done that it does not include the weekends and holidays ("non-business") days.

Once that is done, this would be perfect.

SOLUTION

Gustav Brock

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

lauriecking0623

ASKER

@Cactus_data:

I added the code as basWorkdays but when I put the ISO Workdays where the DateAdd, it does not work well. Did I put it in right?

Me.Expected_Delivery = DateAdd("d", intDays, [Date_Received])

I put Me.Expected_Delivery = ISO_WorkdayAdd("d", intDays, [Date_Received])

I think it is wrong.

Gustav Brock

No, it is different:

Public Function ISO_WorkdayAdd( _
ByVal datDateFrom As Date, _
ByVal lngWorkdaysAdd As Long, _
Optional ByVal bytWorkdaysOfWeek As Byte = 5, _
Optional ByVal booExcludeHolidays As Boolean) _
As Date

Thus:

= ISO_WorkdayAdd([Date_Received], intDays, , True)

/gustav

lauriecking0623

ASKER

I added it like you suggested but it gives me 12/30/1899 in the Expected Delivery.

lauriecking0623

ASKER

@cactus_data:

I put in the code into the Select Case code; however, when I update the Date_received field, it only puts 12/30/1899 in the Expected_Delivery Field. That is it. Do you know why this is doing that?

SOLUTION

Gustav Brock

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

lauriecking0623

ASKER

@cactus_data:

I changed it to your suggestion. It gives me a date; however, I have this record that the date_received is 07/03/2012 so since the next day is 07/04/2012 a national holiday, then it should go to 07/05/2012; however, it shows 07/04/2012.

I have a table in my database called Tbl_Holidays with Holiday_Date for the holidays. I do not know why your code does not take into account the weekend days and holidays.

Is there something I am doing wrong?

Gustav Brock

To take holidays into accent, the last parameter must be True.
Also, the code has to be changed to match your table and field names:

' Name of table with holidays.
Const cstrTableHoliday As String = "tblHoliday"
' Name of date field in holiday table.
Const cstrFieldHoliday As String = "HolidayDate"

/gustav

lauriecking0623

ASKER

I did that both things that you have said. It is back to the 12/30/1899 being filled in the Expected_Delivery field.

Gustav Brock

It indicates that you somehow feed the function with zero values and not current dates.

Does this still work:

Me.Expected_Delivery = DateAdd("d", intDays, [Date_Received])

/gustav

lauriecking0623

ASKER

I will try it in the morning.

lauriecking0623

ASKER

@cactus_data:

I changed it back to the DateAdd and works correctly just does not skip the weekends and holidays.

Gustav Brock

Then, I guess, you somehow have got the code wrong.

If I enter for example:

datNext = ISO_WorkdayAdd(Date, 7)

I receive for datNext:
2012-09-21

which is correct.
You could try to delete and re-copy-paste the functions.

/gustav

lauriecking0623

ASKER

It works great now. The final statement in the code using his Function for keeping out weekends and holidays for my db is

Me.Expected_Delivery = ISO _WorkAdd([Date_Received], intDays, 5, True)

Now things are great!!! Thank you so much!

Gustav Brock

You are welcome! Glad you found out.

/gustav