Yoink
asked on
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
I should receive these results:
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.
Thanks in advance,
JK
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
I should receive these results:
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.
Thanks in advance,
JK
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
Thank you for your help!
JK
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
Thank you for your help!
JK
ASKER
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.
Thanks in advance,
JK