Loop Doesn't Terminate in Access VBA - ms-access

Question

I have a function called "CurveInterpolateRecordset", which is as follows:
Function CurveInterpolateRecordset(rsCurve As Recordset, InterpDate As Date) As Double
Dim I As Long
Dim x1 As Date, x2 As Date, y1 As Double, y2 As Double, x As Date
CurveInterpolateRecordset = Rnd()
If rsCurve.RecordCount <> 0 Then
I = 1
rsCurve.MoveFirst
x1 = CDate(rsCurve.Fields("MaturityDate"))
y1 = CDbl(rsCurve.Fields("ZeroRate"))
If InterpDate = CDate(rsCurve.Fields("MaturityDate")) Then CurveInterpolateRecordset = CDbl(rsCurve.Fields("ZeroRate")): Exit Function
'Do While Not rsCurve.EOF
rsCurve.MoveNext
Do While (CDate(rsCurve.Fields("MaturityDate")) <= InterpDate)
If rsCurve.EOF Then CurveInterpolateRecordset = CDbl(rsCurve.Fields("ZeroRate")): Exit Function
If InterpDate = CDate(rsCurve.Fields("MaturityDate")) Then CurveInterpolateRecordset = CDbl(rsCurve.Fields("ZeroRate")): Exit Function
If InterpDate > CDate(rsCurve.Fields("MaturityDate")) Then
x1 = CDate(rsCurve.Fields("MaturityDate"))
y1 = CDbl(rsCurve.Fields("ZeroRate"))
End If
rsCurve.MoveNext
If rsCurve.EOF Then CurveInterpolateRecordset = y1: Exit Function
Loop
x2 = CDate(rsCurve.Fields("MaturityDate"))
y2 = CDbl(rsCurve.Fields("ZeroRate"))
CurveInterpolateRecordset = y1 + (y2 - y1) * CDate((InterpDate - x1) / (x2 - x1))
End If
Debug.Print I, InterpDate, x1, x2, y1, y2
End Function
This loop will interpolate a missing value for a specific date by interpolating using the values for the nearest dates.
I have a table of dates, some of which need interpolating, so I am using another function to iterate through the recordset and pass the function through each record's corresponding date in order to interpolate the value.
Sub SampleReadCurve()
Dim rs As Recordset
Dim iRow As Long, iField As Long
Dim strSQL As String
Dim CurveID As Long
Dim MarkRunID As Long
Dim ZeroCurveID As String
CurveID = 124
MarkRunID = 10167
ZeroCurveID = "'" & CurveID & "-" & MarkRunID & "'"
'strSQL = "SELECT * FROM dbo_VolatilityInput WHERE ZeroCurveID='124-10167'"
strSQL = "SELECT * FROM dbo_VolatilityInput WHERE ZeroCurveID=" & ZeroCurveID & " ORDER BY MaturityDate"
Set rs = CurrentDb.OpenRecordset(strSQL, Type:=dbOpenDynaset, Options:=dbSeeChanges)
If rs.RecordCount <> 0 Then
Do While Not rs.EOF
rs.MoveFirst
Debug.Print vbCrLf
Debug.Print "First", rs!ZeroCurveID, rs!MaturityDate, rs!ZeroRate, rs!DiscountFactor
rs.MoveLast
Debug.Print "Last", rs!ZeroCurveID, rs!MaturityDate, rs!ZeroRate, rs!DiscountFactor
Debug.Print "There are " & rs.RecordCount & " records and " _
& rs.Fields.Count & " fields."
Dim BucketTermAmt As Long
Dim BucketTermUnit As String
Dim BucketDate As Date
Dim MarkAsOfDate As Date
Dim InterpRate As Double
MarkAsOfDate = rs!MarkAsOfDate
BucketTermAmt = 3
BucketTermUnit = "m"
BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MarkAsOfDate)
InterpRate = CurveInterpolateRecordset(rs, BucketDate)
Debug.Print BucketDate, InterpRate
rs.MoveNext
Loop
End If
End Sub
For one individual record and date, the first function works fine. However, when I execute the second function, the loop keeps repeating infinitely and the program crashes. I don't understand why this happens because there is clearly an end condition in the second loop. The recordset is only 76 records so not extremely large.

Answer 1

Remove the block that starts with rs.MoveFirst and ends with rs.MoveLast from inside your while loop. They should be inside the if but before the while.