# Calculate the date diff based on a 360 day year

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
LVL 2
###### Who is Participating?

Commented:
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

Author Commented:
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

Author Commented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.