CODEWITHSUNDEEP
vbams-access
beeba
beeba

Reputation: 432

Using a Function to Create a New Table in Access VBA

I am new to MS Access VBA and am having difficulty with applying a function to recordset data.

Basically I am dealing with a table of the form:

CurveID MarkRunID MarkAsOfDate ZeroCurveID MaturityDate ZeroRate    DiscountFactor
15      10091     7/2/2015    15-10091    7/2/2015    0.007499923   1
15      10091     7/2/2015    15-10091    7/5/2015    0.007499923   0.999979452
15      10091     7/2/2015    15-10091    8/4/2015    0.00899634    0.999186963
15      10091     7/2/2015    15-10091    9/5/2015    0.008993128   0.998473566
15      10091     7/2/2015    15-10091    10/2/2015   0.005496191   0.998615618
...      ...       ....        ...         ...            ...       ...
15      10102     7/3/2015    15-10102    7/6/2015  0.007499769 0.99993836
15      10102     7/3/2015    15-10102    8/4/2015  0.008996451 0.999211581
15      10102     7/3/2015    15-10102    9/3/2015  0.008993128 0.998473566
...      ...       ....        ...         ...            ...       ...

from MarkAsofDate 7/2/2015 to 7/30/2015.

I am interested in picking out ZeroRate value in the instances in which MarkAsofDate and MaturityDate differ by 3 months, such as for 7/2/2015 and 7/5/2015; 7/3/2015 and 7/6/2015; 7/4/2015 and 7/7/2015; and so on.

I want to create a list of these instances for each MarkAsofDate in the table. If there is no ZeroRate value in the table for a given instance, I wrote a function (CurveInterpolateRecordset) to interpolate the value from the nearest dates.

To create this list, I have the following subroutine:

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_ZeroCurvePoints WHERE ZeroCurveID='124-10167'"
    strSQL = "SELECT * FROM dbo_ZeroCurvePoints WHERE ZeroCurveID=" & ZeroCurveID & " ORDER BY MaturityDate"
    Set rs = CurrentDb.OpenRecordset(strSQL, Type:=dbOpenDynaset, Options:=dbSeeChanges)

    If rs.RecordCount <> 0 Then
        rs.MoveFirst
        Debug.Print vbCrLf
        Debug.Print "First", rs.Fields("ZeroCurveID"), rs.Fields("MaturityDate"), rs.Fields("ZeroRate"), rs.Fields("DiscountFactor")
        rs.MoveLast
        Debug.Print "Last", rs.Fields("ZeroCurveID"), rs.Fields("MaturityDate"), rs.Fields("ZeroRate"), rs.Fields("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 = #7/31/2015#
        BucketTermAmt = 3
        BucketTermUnit = "m"
        BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MarkAsOfDate)
        InterpRate = CurveInterpolateRecordset(rs, BucketDate)
        Debug.Print BucketDate, InterpRate
    End If


End Sub

Basically it's applying a function (CurveInterpolateRecordset) to a specific CurveID, MarkasOfDate and MaturityDate. It'll interpolate one value for me, instead of the list. The output is this:

First         124-10167     7/31/2015      4.99986301870823E-03        1 
Last          124-10167     7/31/2045      0.026229762828488           0.454995484723086 
There are 67 records and 4 fields.
 1            10/31/2015    10/30/2015    12/14/2015     6.84415740792136E-03        6.86250850507399E-03 
10/31/2015     6.84456521008031E-03

How can I change the function that I've written so it can produce the list that I need, rather than one specific value? Thanks.

EDIT

This is the interpolation function referenced earlier. 

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

Upvotes: 0

Views: 89

Answers (1)

Parfait
Parfait

Reputation: 107567

Simply wrap your If/Then logic in a Do While Loop which iterates through each record of recordset passing record's corresponding MarkAsDate into your function and print lines (I remove the verbosity of using rs.Fields() with just an exclamation point):

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        # <-------------CHANGE HERE
        BucketTermAmt = 3
        BucketTermUnit = "m"
        BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MarkAsOfDate)
        InterpRate = CurveInterpolateRecordset(rs, BucketDate)
        Debug.Print BucketDate, InterpRate           

    rs.MoveNext
    Loop
End If

You may even be able to use just an SQL solution. Access queries can use user-defined VBA functions if they are defined as public functions and placed in a module. Simply pass the needed in-line parameters into function and not the whole recordset (but modify function to accept such parameters):

SELECT ZeroCurveID, MaturityDate, ZeroRate, DiscountFactor,
       DateAdd("m", 3, MarkAsOfDate) As BucketDate, 
       CurveInterpolateRecordset(ZeroCurveID, 
                                 MarkAsOfDate, 
                                 MaturityDate,
                                 DateAdd("m", 3, MarkAsOfDate)) As InterpRate    
FROM dbo_ZeroCurvePoints 
WHERE ZeroCurveID = '124-10167' 
ORDER BY MaturityDate

Upvotes: 1

Related Questions