• Home
 · 
• Miscellaneous
 · 
• Getting Numeric Value based on Date From and To surrendered. Possible Value can be Year, Year.Mo

Getting Numeric Value based on Date From and To surrendered. Possible Value can be Year, Year.Mo

Getting Numeric Value based on Date From and To surrendered. Possible Value can be "Year", "Year.Month", "Month", "Month.Days", "Days"

API Declarations


'Accurate computation of Duration based on Date From and To surrendered



Rate Getting Numeric Value based on Date From and To surrendered. Possible Value can be Year, Year.Mo

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Public Function GetPeriodDesired(varValue As Variant, lngToGet As Long, Optional blnLeap As Boolean = True) As Variant
Dim strValue$, intMonth%, intDays%, varResult As Variant

strValue$ = CStr(varValue)
If InStr(1, strValue$, ".") > 0 Then
    intMonth% = Val(Mid(strValue$, 1, InStr(1, strValue$, ".") - 1))
    intDays% = Val(Mid(strValue$, InStr(1, strValue$, ".") + 1))
Else
    intMonth% = Val(strValue$)
End If

'Possible Result
Select Case lngToGet
    Case 1 'Y      - Year(s) Only
        varResult = Fix(intMonth% / 12)
    Case 2 'Y.M    - Year(s).Month(s) Only
        varResult = Fix(intMonth% / 12) & "." & Round(((intMonth% / 12) - Fix(intMonth% / 12)) * 12, 0)
    Case 3 'M      - Month(s) Only
        varResult = intMonth%
    Case 4 'M.D    - Month(s).Day(s) Only
        varResult = intMonth% & "." & intDays%
    Case 5 'D      - Day(s) Only
        varResult = Round(Val(IIf(blnLeap = True, (intMonth% / 12) * 366, (intMonth% / 12) * 365)) + intDays%, 0)
End Select
GetPeriodDesired = varResult

End Function


Public Function GetActualPeriodDiffByCyAccurate(dStart As Date, dEnd As Date, lngToGet As Long, Optional blnLeap As Boolean = True) As String
Dim intNoOfDays%, intDaysPerMonthoftheYear%(12), _
    intDStartMonth%, intDEndMonth%, intYearDiff%, _
    dblTotalMonthsNDays#, _
    ix%, intDaysRemaining%, _
    intMontConsumed%
    
    If (IsNull(dStart) Or IsNull(dEnd)) Or dStart > dEnd Then
        GetActualPeriodDiffByCyAccurate = "0.0"
        Exit Function
    End If
    
    'Tracing of TNoDays in Year of dStart
    intDaysPerMonthoftheYear%(1) = 31
    intDaysPerMonthoftheYear%(2) = IIf(DateDiff("d", CDate("1/1/" & Year(dStart)), CDate("12/31/" & Year(dStart))) = 365, 29, 28)
    intDaysPerMonthoftheYear%(3) = 31
    intDaysPerMonthoftheYear%(4) = 30
    intDaysPerMonthoftheYear%(5) = 31
    intDaysPerMonthoftheYear%(6) = 30
    intDaysPerMonthoftheYear%(7) = 31
    intDaysPerMonthoftheYear%(8) = 31
    intDaysPerMonthoftheYear%(9) = 30
    intDaysPerMonthoftheYear%(10) = 31
    intDaysPerMonthoftheYear%(11) = 30
    intDaysPerMonthoftheYear%(12) = 31
        
    intDStartMonth% = Month(dStart)
    intDEndMonth% = Month(dEnd)
    intYearDiff% = DateDiff("yyyy", dStart, dEnd)
    
    If intYearDiff% > 0 Then
        'Recursive
        For ix% = 0 To intYearDiff%
            If ix% <> intYearDiff% Then
                dblTotalMonthsNDays# = dblTotalMonthsNDays# + Val(GetActualPeriodDiffByCyAccurate(dStart, CDate("12/31/" & Year(dStart) + ix%), 4))
            Else
                dblTotalMonthsNDays# = dblTotalMonthsNDays# + Val(GetActualPeriodDiffByCyAccurate(CDate("1/1/" & Year(dEnd)), dEnd, 4))
            End If
        Next
        
        GetActualPeriodDiffByCyAccurate = GetPeriodDesired(dblTotalMonthsNDays#, lngToGet, blnLeap)
        
    ElseIf intYearDiff% = 0 Then
        If intDStartMonth% = intDEndMonth% Then
            intNoOfDays% = DateDiff("d", dStart, dEnd) + 1
            If intNoOfDays% = intDaysPerMonthoftheYear%(intDStartMonth%) Then
                GetActualPeriodDiffByCyAccurate = GetPeriodDesired(CDbl("1"), lngToGet, blnLeap)
            Else
                GetActualPeriodDiffByCyAccurate = GetPeriodDesired(CDbl(intMontConsumed% & "." & (DateDiff("d", dStart, dEnd) + 1)), lngToGet, blnLeap)
            End If
            Exit Function
        ElseIf intDStartMonth% <> intDEndMonth% Then
            intNoOfDays% = DateDiff("d", dStart, dEnd) + 1
            For ix% = intDStartMonth% To intDEndMonth%
                If intNoOfDays% >= intDaysPerMonthoftheYear%(ix%) Then
                    intMontConsumed% = intMontConsumed% + 1
                    intNoOfDays% = intNoOfDays% - intDaysPerMonthoftheYear%(ix%)
                Else
                    intDaysRemaining% = intNoOfDays%
                End If
            Next
            GetActualPeriodDiffByCyAccurate = GetPeriodDesired(CDbl(CStr(intMontConsumed%) & "." & CStr(intDaysRemaining%)), lngToGet, blnLeap)
        End If
    End If
    
End Function