Untitled

caffeine314

Jun 15th, 2025

563

Never

Add comment

Not a member of Pastebin yet? Sign Up, it unlocks many cool features!

VisualBasic 1.62 KB | None | 0 0

raw download clone embed print report

Public Function InterpolatedRate(targetDate As Date, dataRange As Range) As Variant
Dim datesRange As Range, ratesRange As Range
Dim idx As Variant
Dim date1 As Date, date2 As Date
Dim rate1 As Double, rate2 As Double
' Make sure there are two columns.
If dataRange.Columns.Count <> 2 Then
InterpolatedRate = CVErr(xlErrRef)
Exit Function
End If
' Set dataRange = TrimEmptyRows(dataRange)
Set datesRange = dataRange.Columns(1)
Set ratesRange = dataRange.Columns(2)
' Make sure targetDate is a date
If Not IsDate(targetDate) Then Debug.Print "targetDate not a date: " & targetDate
' Make sure the target date is AFTER the first date in our range.
Dim firstDate As Date: firstDate = datesRange.Cells(1, 1).Value
If targetDate < firstDate Then Debug.Print "targetDate < dateRange: " & DateRange.Cells(1, 1).Value
' Make sure everything is a date.
For Each c In datesRange
If IsDate(c.Value) Then c.Value = CDate(c.Value)
Next
On Error Resume Next
idx = Application.Match(targetDate, datesRange, 1)
On Error GoTo 0
' Can't combine this with below because of short circuiting behavior.
'If IsError(idx) Then
' InterpolatedRate = CVErr(xlErrNA)
' Exit Function
'End If
'date1 = datesRange.Cells(idx, 1).Value
'date2 = datesRange.Cells(idx + 1, 1).Value
'rate1 = ratesRange.Cells(idx, 1).Value
'rate2 = ratesRange.Cells(idx + 1, 1).Value
' InterpolatedRate = LinearInterpolate(CDbl(targetDate), CDbl(date1), CDbl(date2), rate1, rate2)
End Function

Add Comment

Please, Sign In to add comment