Storing Arrays in Access VBA

Question

I have coded a subroutine in Access VBA, shown here for reference: Looping Through Dates in strSQL in Access VBA. It is as follows:

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 MaxOfMarkAsofDate As Date
Dim userdate As String

CurveID = 15

Dim I As Integer
Dim x As Date

userdate = InputBox("Please Enter the Date (mm/dd/yyyy)")

x = userdate

For I = 0 To 150

MaxOfMarkAsofDate = x - I


strSQL = "SELECT * FROM VolatilityOutput WHERE CurveID=" & CurveID & " AND MaxOfMarkAsofDate=#" & MaxOfMarkAsofDate & "# ORDER BY MaxOfMarkasOfDate, MaturityDate"

Set rs = CurrentDb.OpenRecordset(strSQL, Type:=dbOpenDynaset, Options:=dbSeeChanges)
If rs.RecordCount <> 0 Then

    rs.MoveFirst

    rs.MoveLast

    Dim BucketTermAmt As Long
    Dim BucketTermUnit As String
    Dim BucketDate As Date
    Dim MarkAsOfDate As Date
    Dim InterpRate As Double

    BucketTermAmt = 3
    BucketTermUnit = "m"
    BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MaxOfMarkAsofDate)
    InterpRate = CurveInterpolateRecordset(rs, BucketDate)
    Debug.Print BucketDate, InterpRate

End If

Next I


End Function

Running this subroutine calculates a range of 76 numbers. I want to take these 76 numbers, and use them in the following function as "ZeroCurveInput".

Function EWMA(ZeroCurveInput As Range, Lambda As Double) As Double

    Dim vZeros() As Variant
    vZeros = ZeroCurveInput
    Dim Price1 As Double, Price2 As Double
    Dim SumWtdRtn As Double
    Dim I As Long
    Dim m As Double

    Dim LogRtn As Double, RtnSQ As Double, WT As Double, WtdRtn As Double

vZeros = ZeroCurveInput

m = BucketTermAmt

For I = 2 To UBound(vZeros, 1)

    Price1 = Exp(-vZeros(I - 1, 1) * (m / 12))

    Price2 = Exp(-vZeros(I, 1) * (m / 12))

    LogRtn = Log(Price1 / Price2)

    RtnSQ = LogRtn ^ 2

    WT = (1 - Lambda) * Lambda ^ (I - 2)

    WtdRtn = WT * RtnSQ

    SumWtdRtn = SumWtdRtn + WtdRtn

Next I

EWMA = SumWtdRtn ^ (1 / 2)

End Function

I originally coded this function in Excel VBA and I'm trying to port it to Access VBA. In Excel, I'd just read that column of 76 numbers as range and dimension it as variant to store as an array, then use it in the function. However I can't use the range property in Access to do something similar and I'm not sure what to use instead.

How would I store the numbers as an array, and then pass them into the function?

Answer 1

There are a few different ways you could do this, including using an array as you suggest. If all you need are the 76 numbers, you could do this using a collection. The advantage to the collection is you don't need to know ahead of time how many items will be in it.

Here's a simple working example of using a collection:

Sub TestColl()
    Dim TestCollection As Collection
    Set TestCollection = CreateColl()
    LoopThruColl TestCollection
End Sub
Function CreateColl() As Collection
    Dim MyColl As Collection
    Set MyColl = New Collection

    Dim i As Integer
    For i = 1 To 5
        MyColl.Add i * 2
    Next i
    Set CreateColl = MyColl
End Function
Sub LoopThruColl(CollToLoop As Collection)
    Dim i As Integer
    For i = 2 To CollToLoop.Count
        Debug.Print i, CollToLoop.Item(i - 1), CollToLoop.Item(i)
    Next i
End Sub

Answer 2

You could also simply write the numbers from SampleReadCurve to a table, and then loop through the table same as you'd loop through your array. So, your sub would change to this (as an aside, does this work? You're creating a Sub and ending a Function...):

Sub SampleReadCurve()

Dim rs As Recordset
Dim rs2 as Recordset
Dim iRow As Long, iField As Long
Dim strSQL As String
Dim CurveID As Long
Dim MarkRunID As Long
Dim MaxOfMarkAsofDate As Date
Dim userdate As String

CurveID = 15

Dim I As Integer
Dim x As Date

userdate = InputBox("Please Enter the Date (mm/dd/yyyy)")

x = userdate

For I = 0 To 150

MaxOfMarkAsofDate = x - I


strSQL = "SELECT * FROM VolatilityOutput WHERE CurveID=" & CurveID & " AND MaxOfMarkAsofDate=#" & MaxOfMarkAsofDate & "# ORDER BY MaxOfMarkasOfDate, MaturityDate"

Set rs = CurrentDb.OpenRecordset(strSQL, Type:=dbOpenDynaset, Options:=dbSeeChanges)
Set rs2 = CurrentDb.OpenRecordset("MyNewTable")

If rs.RecordCount <> 0 Then

    rs.MoveFirst

    rs.MoveLast

    Dim BucketTermAmt As Long
    Dim BucketTermUnit As String
    Dim BucketDate As Date
    Dim MarkAsOfDate As Date
    Dim InterpRate As Double

    BucketTermAmt = 3
    BucketTermUnit = "m"
    BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MaxOfMarkAsofDate)
    InterpRate = CurveInterpolateRecordset(rs, BucketDate)
    Debug.Print BucketDate, InterpRate
    rs2.AddNew
    rs2("BucketDate") = BucketDate
    rs2("InterpRate") = InterpRate
    rs2.Update

End If

Next I


End Function

Then your EWMA function would look like this:

Function EWMA(Lambda As Double) As Double

    Dim Price1 As Double, Price2 As Double
    Dim SumWtdRtn As Double
    Dim I As Long
    Dim m As Double
    Dim rec as Recordset

    Dim LogRtn As Double, RtnSQ As Double, WT As Double, WtdRtn As Double

m = BucketTermAmt

Set rec = CurrentDB.OpenRecordset("SELECT InterpRate FROM MyNewTable")

I = 2
Do While rec.EOF = False

    Price1 = Exp(-rec("InterpRate")(I - 1, 1) * (m / 12))
    Price2 = Exp(-rec("InterpRate")(I, 1) * (m / 12))
    LogRtn = Log(Price1 / Price2)
    RtnSQ = LogRtn ^ 2
    WT = (1 - Lambda) * Lambda ^ (I - 2)
    WtdRtn = WT * RtnSQ
    SumWtdRtn = SumWtdRtn + WtdRtn
    I = I + 1

Loop

EWMA = SumWtdRtn ^ (1 / 2)

End Function