Solved

Calculate the date diff based on a 360 day year

Posted on 2002-03-15
3
602 Views
Last Modified: 2011-10-03
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
0
Comment
Question by:Yoink
  • 2
3 Comments
 
LVL 2

Accepted Solution

by:
xtrahands earned 200 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

by:Yoink
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.

Thanks in advance,

JK
0
 
LVL 2

Author Comment

by:Yoink
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

Thank you for your help!

JK
0

Featured Post

Complete Microsoft Windows PC® & Mac Backup

Backup and recovery solutions to protect all your PCs & Mac– on-premises or in remote locations. Acronis backs up entire PC or Mac with patented reliable disk imaging technology and you will be able to restore workstations to a new, dissimilar hardware in minutes.

Join & Write a Comment

Today's users almost expect this to happen in all search boxes. After all, if their favourite search engine juggles with tens of thousand keywords while they type, and suggests matching phrases on the fly, why shouldn't they expect the same from you…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Familiarize people with the process of utilizing SQL Server functions from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Ac…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now