Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
Solved

# Calculate the date diff based on a 360 day year

Posted on 2002-03-15
Medium Priority
747 Views
In Access2K, I am trying to write a function that will calculate the difference between two dates based on a 360 day year.  This assumes there are 30 days in each month as opposed to the actual number of days in any given calendar month.

I have code that will calculate the difference based on a 365 day year, however, there are times when I have to calculate the difference based on 360 day year.

I have a table with three fields:  TranOrder, EffDate and Days.  Here is the code I am using:

Public Function DaysInMonth(intMonth As Integer, intYear As Integer)
Dim datDate As Date
datDate = DateSerial(intYear, intMonth + 1, 0)
DaysInMonth = Day(datDate)
End Function

Function NewUpdateDays()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Days As Variant
Dim TranOrder As String
Dim strSQL As String
Dim strMonth As String
Dim strEffDate As String
Dim strCurrMonth As String
Dim strPrevMonth As String
Dim strMonthDiff As String
Dim AccrMethod
Dim DayCount As String
Dim frm As Form

'Dim strAccMethod As String

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT tblHistScrape.* " _
& "FROM tblHistScrape " _
& "ORDER BY TranOrder ASC;", dbOpenDynaset)
Set frm = Forms!frmDataEntry
AccrMethod = frm!txtAccrMethod

rs.FindFirst "[TranOrder]>1"
Do
TranOrder = rs!TranOrder
strCurrMonth = DatePart("m", rs!effdate)
strEffDate = DatePart("d", rs!effdate)
rs.MovePrevious
TranOrder = rs!TranOrder
strPrevMonth = DatePart("m", rs!effdate)
DayCount = DaysInMonth(DatePart("m", rs!effdate), DatePart("yyyy", rs!effdate))

strMonthDiff = strCurrMonth - strPrevMonth

If strMonthDiff = -11 Then
strMonthDiff = 1
ElseIf strMonthDiff = -10 Then
strMonthDiff = 2
ElseIf strMonthDiff = -9 Then
strMonthDiff = 3
ElseIf strMonthDiff = -8 Then
strMonthDiff = 4
ElseIf strMonthDiff = -7 Then
strMonthDiff = 5
ElseIf strMonthDiff = -6 Then
strMonthDiff = 6
ElseIf strMonthDiff = -5 Then
strMonthDiff = 7
ElseIf strMonthDiff = -4 Then
strMonthDiff = 8
ElseIf strMonthDiff = -3 Then
strMonthDiff = 9
ElseIf strMonthDiff = -2 Then
strMonthDiff = 10
ElseIf strMonthDiff = -1 Then
strMonthDiff = 11
End If

If TranOrder = 1 Then

If DayCount = 31 Then
Days = rs!effdate
rs.MoveNext
rs.Edit
'Days = rs!effdate - Days - 1
Days = rs!effdate - Days
rs!Days = Days
rs.Update
rs.MoveNext
Else
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days
rs!Days = Days
rs.Update
rs.MoveNext
End If

Else

Select Case AccrMethod
'***Do not alter!!!***
Case Is = "365" 'This case works!!!
TranOrder = rs!TranOrder
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days
rs!Days = Days
rs.Update
rs.MoveNext
'***Do not alter!!!***

Case Is = "360"

Select Case DayCount
Case Is = "28"
If strCurrMonth = strPrevMonth Then
TranOrder = rs!TranOrder
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days
rs!Days = Days
rs.Update
rs.MoveNext
Else
TranOrder = rs!TranOrder
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days + 2
rs!Days = Days
rs.Update
rs.MoveNext
End If

Case Is = "29"
If strCurrMonth = strPrevMonth Then
TranOrder = rs!TranOrder
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days
rs!Days = Days
rs.Update
rs.MoveNext
Else
TranOrder = rs!TranOrder
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days + 1
rs!Days = Days
rs.Update
rs.MoveNext
End If

Case Is = "30"
TranOrder = rs!TranOrder
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days
rs!Days = Days
rs.Update
rs.MoveNext

Case Is = "31"
If strCurrMonth = strPrevMonth And strEffDate = 31 Then
TranOrder = rs!TranOrder
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days - 1
rs!Days = Days
rs.Update
rs.MoveNext
ElseIf strCurrMonth = strPrevMonth And strEffDate <> 31 Then
TranOrder = rs!TranOrder
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days
rs!Days = Days
rs.Update
rs.MoveNext
ElseIf strCurrMonth <> strPrevMonth Then
TranOrder = rs!TranOrder
Days = rs!effdate
rs.MoveNext
rs.Edit
Days = rs!effdate - Days - strMonthDiff
rs!Days = Days
rs.Update
rs.MoveNext
End If

End Select

Case Is = "366"
'***To be completed***
End Select
End If

Loop Until rs.EOF
End Function

The above function will populate the Days field on my table.  When I run the above code based on a 360 day year, I receive the following results:

TranOrder      EffDate         Days
1              1/8/1996
4              3/4/1996   56
5              3/29/1996  25
6              5/2/1996   32
7              5/31/1996  28
8              7/1/1996   29
10              7/31/1996  29
11              8/30/1996  29
12              10/2/1996  31
13              10/4/1996  2
14              11/1/1996  27

TranOrder      EffDate         Days
1              1/8/1996
4              3/4/1996   56
5              3/29/1996  25
6              5/2/1996   33
7              5/31/1996  28
8              7/1/1996   31
10              7/31/1996  29
11              8/30/1996  30
12              10/2/1996  32
13              10/4/1996  2
14              11/1/1996  27

The number of days on TranOrder 6 is off by one day.  The number of days on TranOrder 8 is off by two days.

I also need to take into account leap year.

Gee… I am not asking for too much…. {:>)

Any help will be greatly appreciated.

JK
0
Question by:Yoink
• 2

LVL 2

Accepted Solution

xtrahands earned 800 total points
ID: 6869399
Sorry Yoink

I pretty much started from scratch to get the result.  Attached is my version of the code.  I was wondering why you are using string variables for numbers and I thought it could be done with much less code.  I have written it in A97 but since you are using DAO I didn't see it as an issue.

I wasn't sure what you wanted to do with leap years.  At the moment the code assumes that if it is leap year there are 366 days in the 365 day year.

Regards
Xtrahands

Function NewUpdateDays()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim dte1 As Date
Dim dte2 As Date

Dim TranOrder As String
Dim strSQL As String
Dim intAccrMethod As Integer
Dim intDayCount As Integer
Dim frm As Form

'Dim strAccMethod As String

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT tblHistScrape.* " _
& "FROM tblHistScrape " _
& "ORDER BY TranOrder ASC;", dbOpenDynaset)
Set frm = Forms!frmDataEntry
intAccrMethod = frm!txtAccrMethod

With rs
dte1 = !effdate
.MoveNext

Do
dte2 = !effdate
intDayCount = getdiff(dte1, dte2, intAccrMethod)
.Edit
!Days = intDayCount
.Update
dte1 = dte2
.MoveNext
Loop Until rs.EOF
End With

End Function

Function getdiff(dte1 As Date, dte2 As Date, intAccrMethod As Integer) As Long

Dim lngDayDiff As Long
Dim lngMthDiff As Long
Dim dteEOM1 As Date
Dim intDays As Integer

Select Case intAccrMethod
Case 365, 366
lngDayDiff = DateDiff("y", dte1, dte2)
Case 360
If DatePart("d", dte1) > 30 Then
intDays = 0
Else
intDays = 30 - DatePart("d", dte1)
End If
dteEOM1 = DateSerial(Year(dte1), Month(dte1) + 1, 1)
lngMthDiff = DateDiff("m", dteEOM1, dte2)
lngDayDiff = intDays + 30 * lngMthDiff + DatePart("D", dte2)
Case Else
End Select

getdiff = lngDayDiff
End Function

0

LVL 2

Author Comment

ID: 6869451
xtrahands,

I do need to take into account leap years.

I am still learning VBA, so I may not always code in the most efficient manner.  Less code is always better!

I will take a look at this over the weekend and get back to you.

JK
0

LVL 2

Author Comment

ID: 6876846
xtrahands,

I just ran a verification, and your solution worked perfectly with one exception.  When DatePart("d",dte2) =31, an extra day was being added to !Days.  Adding one simple IF statement took care of this issue:

If DatePart("d", dte2) = 31 Then
dte2 = !effDate - 1
Else
End If

JK
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
Enter Foreign and Special Characters Enter characters you can't find on a keyboard using its ASCII code ... and learn how to make a handy reference for yourself using Excel ~ Use these codes in any Windows application! ... whether it is a Micr…
###### Suggested Courses
Course of the Month13 days, 21 hours left to enroll