Loop Doesn't Terminate in Access VBA

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.

You should define your fields with the proper data type like Date. Then you can reduce to: x1 = rsCurve.Fields("MaturityDate").Value — Gustav
– Gustav, Commented Nov 26, 2015 at 16:17

Vinicius Kamakura · Accepted Answer · 2015-11-26 16:03:15Z

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.

edited Nov 26, 2015 at 16:03

answered Nov 26, 2015 at 16:01

Vinicius Kamakura

7,8121 gold badge31 silver badges44 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

beeba Over a year ago

for the first function or the second sub? I removed it from the second sub but I am still getting the same problem

beeba Over a year ago

the same error still occurs, do you think any other part of the code could be causing the issue?

beeba Over a year ago

I removed the block - it now prints "10/31/2015 6.844E-03" repeatedly before crashing, which is the BucketDate and InterpRate but only for that one specific date. I am not sure why it is calculating the InterpRate for that same date over and over again instead of iterating through the records

Collectives™ on Stack Overflow

Loop Doesn't Terminate in Access VBA

1 Answer 1

3 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

3 Comments

Your Answer

Sign up or log in

Post as a guest

Related