Programming "Yield" function in Access

[Valkor]

Hi, I've been looking for a way to program/calculate "yield" function in
Microsoft Access. Finnaly I found a procedure on one of usenet groups. 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

 

[Larry Linson]

That's one of the problems with just copying and pasting code without
understanding it. There seems to be no error-handling code, so if you open
Tools | Options in the VBA code window, and check to Stop on Unhandled
Errors, when the error occurs, it should stop on the statement causing the
error, and that would be useful information.

Some of the code here is not suitable for "inserting" on a Button Event...
certainly not all of it is... one procedure can be inserted on an event. You
have some code that is not in a procedure, and you have multiple function
and sub procedures.

It might also be useful to know in what event you inserted the code.

I won't even assure you that when/if you do provide all the necessary
information, that I'll have the time and energy to work on debugging the
code for you. But, with enough additional information, it is possible that
someone will be able to offer a useful suggestion.

Larry Linson
Microsoft Office Access MVP

 

[Valkor]

Thanks Larry, my goal is to be able to compute "yield" using Microsoft
Access. This function is available only in Excel. In addition, even Excel
limits frequency of payments to only 1,2, or 4. I need 12. So, the option of
automate Excel in Access wouldn't really help either. I do have "Break on
unhandled errors" option checked. That's how I've got "User defined type not
defined" compile error and it points to "Private Function
CalculatedPrice(BondInfo As BondInfoType, Yld As Double)" line. My
understanding is that somehow I need to create/define "user type" and I don't
know how. Thanks in advance.

 

[Jon Lewis]

A couple of things that may help you:

Have you placed all this code in a Standard Module? I say that as Type
BondInfoType is implicitly defined as Public which is not allowed in a
Form's class module, so if not I think you should have. I guess the idea is
to call one of the public functions BondPrice or BondYield from a form.

If you try and compile the code you will see that Access doesn't recognise
'Application.Days360' in Private Sub CalculateRemainingParameters . This is
because Days360 is an Excel function. A quick Google will reveal this
thread amongst others to deal with this:
http://www.pcreview.co.uk/forums/thread-1095145.php

Other than that, the code seems to compile OK and I would expect an user
defined type undefined error to be revealed on compile, so maybe the above
will solve your problem.

HTH

Jon

 

[David W. Fenton]

That's how I've got "User defined type not
defined" compile error and it points to "Private Function
CalculatedPrice(BondInfo As BondInfoType, Yld As Double)" line. My
understanding is that somehow I need to create/define "user type"
and I don't know how. Thanks in advance.

Somewhere in the source where you got the code, there should be a
TYPE definition for BondInfoType. It would be in the declarations
section at the top of a module. In fact, in the code you posted,
it's right there at the top:

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

So there must be something else that's failing the compile.

When I paste your code into an Access module, this is what doesn't
compile:

CouponPeriodLength = Application.Days360(CouponBefore,
CouponAfter)

....because Days360 is an Excel function. But if I paste the code
into an Excel module, it won't compile because user-defined types
cannot be public in Excel. Changing:

Type BondInfoType

....to:

Private Type BondInfoType

....makes it compile in Excel.

I don't know how this could happen, since the code as you posted it
could run in neither Excel nor Access:

1. it can't run in Excel without the PRIVATE keyword on the type
declaration.

2. it can't run in Access because it uses and Excel function,
Days360().

So, I don't know what to say.

In Access, you either need to use a reference to Excel so you can
use the Days360() function, or you need to replace the Excel
function with its equivalent in Access. I don't know what Days360()
should return, so I can't tell you what the internal structure of it
should be, but I can say this from working to get the code to
compile:

1. the arguments for the function should be date types:

Private Function Days360(dteStart As Date, dteEnd As Date) _
As Integer

2. if you do that, the code won't compile because the function
CalculateRemainingParameters passes two variables of type Long to
the Days360 function:

Private Sub CalculateRemainingParameters(BondInfo As BondInfoType)
Dim CouponAfter As Long
Dim CouponBefore As Long

[snip]

CouponPeriodLength = Application.Days360(CouponBefore,
CouponAfter) DaysSettleToCoupon = Application.Days360(.Settlement,
CouponAfter)

But if you change your declaration of your replacement function to
use Longs:

Private Function Days360(lngStart As Long, lngEnd As Long) _
As Integer

....that breaks the code that passes values from the user-defined
type, as in this line in CalculateRemainingParameters:

DaysSettleToCoupon = Days360(BondInfo.Settlement,
CDate(CouponAfter))

So, the solution is not to define the arguments for your Days360 as
longs, but to coerce the long variables to date types:

CouponPeriodLength = Application.Days360(CLng(CouponBefore), _
Clng(CouponAfter))
DaysSettleToCoupon = Application.Days360(.Settlement, _
CLng(CouponAfter))

Once that's done, the code compiles.

But I haven't written any content for Days360.

If you set a reference to Excel, you can change the code to this:

Dim xl As Excel.Application

[snip]

CouponPeriodLength = xl.Days360(CouponBefore, CouponAfter)
DaysSettleToCoupon = xl.Days360(.Settlement, CouponAfter)

....and that guarantees that you're getting the results you need.
Alternatively, you could use late binding so you didn't need the
reference:

Dim xl As Object

[snip]

Set xl = CreateObject("Excel.Application")
CouponPeriodLength = xl.Days360(CouponBefore, CouponAfter)
DaysSettleToCoupon = xl.Days360(.Settlement, CouponAfter)

[snip]

xl.Quit
Set xl = Nothing

As the code stands, if you pasted it into a new standalone module
and add the Excel reference, it should work just fine. You'd then
use it in your form by calling the BondYield() function. Where you
call that depends on what you're doing with the thing. For instance,
if you had a form to calculate bond yield with a bunch of fields to
collect the parameters and a command button that does the
calculation, the OnClick() event behind that command button would
look something like this:

Private Sub cmdCalculateYield_OnClick()
Me!txtYield = BondYield(Me!txtSettlementDate, _
Me!txtMaturityDate, Me!txtRate, Me!txtPrice, _
Me!txtRedemption,Me!txtFrequency,Me!txtBasis)
End Sub

Now, all the textboxes on your form would have to be filled out with
valid values for that to work, but that should get you started, I
think.

 

[Valkor]

Jon, thank you very much. It works.

A couple of things that may help you:

Have you placed all this code in a Standard Module? I say that as Type
BondInfoType is implicitly defined as Public which is not allowed in a
Form's class module, so if not I think you should have. I guess the idea is
to call one of the public functions BondPrice or BondYield from a form.

If you try and compile the code you will see that Access doesn't recognise
'Application.Days360' in Private Sub CalculateRemainingParameters . This is
because Days360 is an Excel function. A quick Google will reveal this
thread amongst others to deal with this:
http://www.pcreview.co.uk/forums/thread-1095145.php

Other than that, the code seems to compile OK and I would expect an user
defined type undefined error to be revealed on compile, so maybe the above
will solve your problem.

HTH

Jon




.