by Cyrus Lacaba aka Biohazard of Las Pi?as (6 Submissions)
Category: Miscellaneous
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Fri 17th July 2009
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
No comments have been posted about Getting Numeric Value based on Date From and To surrendered. Possible Value can be Year, Year.Mo. Why not be the first to post a comment about Getting Numeric Value based on Date From and To surrendered. Possible Value can be Year, Year.Mo.
