Programming "yield" function in Microsoft Access

[valkor]

Hi, I've been looking for a way to program/calculate "yield" function
in Microsoft Access. I know this forum is for Excel users but the
procedure I found on this form. This procedure was created by Mirna
Larson back in 2004. Looks like everything should work and this is
exactly what I need. However I’m getting “User defined type” error. I
tried to use references to different libraries – same error. I’m not
an advanced Access VBA user. Basically I created a button on a form
and inserted the code thinking that if this works I should be able to
customize this later. Probably I needed to do something else.
If someone would help me out I would appreciate. Below is the code:

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Option Explicit
Type BondInfoType
'supplied parameters
Settlement As Date
Maturity As Date
Rate As Double
Price As Double
Redemption As Double
Frequency As Long
Basis As Long
'calculated parameters
Coupon As Double
NumCoupons As Long
FraxPeriod As Double
AccrInt As Double
End Type
Function BondYield(Settlement As Date, Maturity As Date, _
Rate As Double, Price As Double, Redemption As Double, _
Frequency As Long, Optional Basis As Long = 0) As Variant
Dim BondInfo As BondInfoType
Dim Diff As Double
Dim i As Long
Dim MaxYield As Double
Dim MinYield As Double
Dim Msg As String
Dim Yld As Double
Const Accuracy As Double = 0.0001
Const MaxIterations As Long = 200
With BondInfo
.Settlement = Settlement
.Maturity = Maturity
.Rate = Rate
.Price = Price
.Redemption = Redemption
.Frequency = Frequency
.Basis = Basis
End With
If CheckArguments(BondInfo, Msg) = False Then
BondYield = Msg
Exit Function
End If
CalculateRemainingParameters BondInfo
With BondInfo
If .NumCoupons = 1 Then
Yld = YieldWith1Coupon(BondInfo)
Else
MinYield = -1#
MaxYield = .Rate
If MaxYield = 0 Then MaxYield = 0.1
Do While CalculatedPrice(BondInfo, MaxYield) > .Price
MaxYield = MaxYield * 2
Loop
Yld = 0.5 * (MinYield + MaxYield)
For i = 1 To MaxIterations
Diff = CalculatedPrice(BondInfo, Yld) - .Price
If Abs(Diff) < Accuracy Then Exit For
'if calculated price is greater, correct yield is greater
If Diff > 0 Then MinYield = Yld Else MaxYield = Yld
Yld = 0.5 * (MinYield + MaxYield)
Next i
End If
BondYield = Yld
End With
End Function 'BondYield
Function BondPrice(Settlement As Date, Maturity As Date, _
Rate As Double, Yield As Double, Redemption As Double, _
Frequency As Long, Optional Basis As Long = 0) As Variant
Dim BondInfo As BondInfoType
Dim Msg As String
With BondInfo
.Settlement = Settlement
.Maturity = Maturity
.Rate = Rate
.Price = 100 'dummy value for CheckArguments
.Redemption = Redemption
.Frequency = Frequency
.Basis = Basis
End With
If CheckArguments(BondInfo, Msg) = False Then
BondPrice = Msg
Else
CalculateRemainingParameters BondInfo
BondPrice = CalculatedPrice(BondInfo, Yield)
End If
End Function 'BondPrice
Private Function CalculatedPrice(BondInfo As BondInfoType, Yld As
Double)
Dim Coupon As Double
Dim K As Long
Dim n As Long
Dim Price As Double
Dim t As Double
Dim y As Double
With BondInfo
n = .NumCoupons
y = 1 + Yld / .Frequency
t = .FraxPeriod 'time to first coupon in periods
Coupon = .Coupon
'present value of the redemption price
Price = .Redemption * (y ^ -(n - 1 + t))
'add present value of the coupons
If Coupon > 0 Then
For K = 1 To n
Price = Price + Coupon * (y ^ -t) 'Y^(-t) = 1/(Y^t)
t = t + 1
Next K
End If
'subtract accrued interest
Price = Price - .AccrInt
End With
CalculatedPrice = Price
End Function 'CalculatedPrice
Private Sub CalculateRemainingParameters(BondInfo As BondInfoType)
Dim CouponAfter As Long
Dim CouponBefore As Long
Dim DaysSettleToCoupon As Long
Dim CouponPeriodLength As Long 'in days
Dim Settle As Long
With BondInfo
.Coupon = 100 * .Rate / .Frequency
GetCouponDates BondInfo, CouponBefore, CouponAfter
If .Basis = 0 Then
CouponPeriodLength = Application.Days360(CouponBefore,
CouponAfter)
DaysSettleToCoupon = Application.Days360(.Settlement,
CouponAfter)
Else
CouponPeriodLength = CouponAfter - CouponBefore
DaysSettleToCoupon = CouponAfter - .Settlement
End If
.FraxPeriod = DaysSettleToCoupon / CouponPeriodLength
.AccrInt = .Coupon * (1 - .FraxPeriod)
End With
End Sub 'CalculateRemainingParameters
Private Function CheckArguments(BondInfo As BondInfoType, _
Msg As String) As Boolean
Dim OK As Boolean
With BondInfo
OK = False
Msg = ""
Do
If .Settlement >= .Maturity Then _
Msg = "Settlement date >= maturity date": Exit Do
If .Rate < 0 Then Msg = "Rate < 0": Exit Do
If .Price <= 0 Then Msg = "Purchase price <= 0": Exit Do
If .Redemption <= 0 Then Msg = "Redemption price <= 0": Exit Do
Select Case .Frequency
Case 1, 2, 3, 4, 6, 12
Case Else
Msg = "Frequency must be 1, 2, 3, 4, 6, or 12"
Exit Do
End Select
Select Case .Basis
Case 0, 1
OK = True: Exit Do
Case Else
Msg = "Basis must be 0 or 1": Exit Do
End Select
Loop
End With
CheckArguments = OK
End Function 'CheckArguments
Private Sub GetCouponDates(BondInfo As BondInfoType, _
PrevCoup As Long, NextCoup As Long)
Dim MonthsBetweenCoupons As Integer
With BondInfo
MonthsBetweenCoupons = 12 \ .Frequency
PrevCoup = DateSerial(Year(.Settlement) + 1, Month(.Maturity),
Day(.Maturity))
If PrevCoup > .Maturity Then PrevCoup = .Maturity
Do While PrevCoup > .Settlement
PrevCoup = DateAdd("m", -MonthsBetweenCoupons, PrevCoup)
Loop
.NumCoupons = DateDiff("m", PrevCoup, .Maturity) \
MonthsBetweenCoupons
NextCoup = DateAdd("m", MonthsBetweenCoupons, PrevCoup)
End With
End Sub 'GetCouponDates
Private Function YieldWith1Coupon(BondInfo As BondInfoType) As Double
Dim Cost As Double
Dim Gain As Double
Dim Proceeds As Double
Dim t As Double
With BondInfo
Proceeds = .Redemption + .Coupon 'receive at maturity
Cost = .Price + .AccrInt 'pay at purchase
Gain = Proceeds / Cost - 1
t = .FraxPeriod / .Frequency 'time in years = frax * 1 /
freq
End With
YieldWith1Coupon = Gain / t
End Function 'YieldWith1Coupon