cwilson30341
New member
- Local time
- Today, 09:40
- Joined
- Nov 21, 2006
- Messages
- 8
Hi all,
MS Access 2003. I got this from a consultant a few months ago and it isn't working correctly. Unfortunately, he is no longer with the company and he was the brains.
I think it is breaking down here since I get the "Error looking up Treasury Premium values for the COF date. Make sure that you have the Treasury Premiums table imported into this tool" error message:
The Treasury_Premium table is loaded and has all of the records that are needed.
Any help that you all can give is greatly appreciated.
Chris
MS Access 2003. I got this from a consultant a few months ago and it isn't working correctly. Unfortunately, he is no longer with the company and he was the brains.
Code:
Sub FTP_Calculator()
' Declarations
Dim iMonth As Long, iInterpMonth1 As Long, iInterpMonth2 As Long
Dim iDate As Long, iDatesCount As Long, iHE_Term As Long
Dim FTP_Date As Date, FTP_Rate As Double
Dim COF_Date As Date, COF_Rate As Double, COF_Term As Long, COF_Product As String
Dim COF_Base As Double, COF_RateLock As Double, COF_Prepayment As Double
Dim sProductDescr As String, sProductCode As String, sYearMonth As String, sCriteria As String
Dim CPR As Double, SMM As Double
Dim iProgressBarWidth As Long, iRowsPerUpdate As Long, iRowCount As Long, iTotalRows As Long
Dim Months(1 To 360, 1 To 2) As Long
Dim Dates() As Date
Dim YieldCurve() As Double
Dim Appl As Access.Application
Dim rsRates As New ADODB.Recordset, rsDates As New ADODB.Recordset
Dim rsCOF As New ADODB.Recordset
' Define application object
Set Appl = Access.Application
' Progress bar parameters
iProgressBarWidth = 1440 * 3 'Measured in twips, 1440 twips = 1 inch
Appl.Forms("fDataEnvironment")!lblProgressBar.Width = iProgressBarWidth / 100
DoEvents
' Get constant values
CPR = Appl.DLookup("CPR", "Constants")
SMM = 1 - (1 - CPR) ^ (1 / 12)
' Store the results of the qFTP_Dates query in a local array
rsDates.Open "qFTP_Dates", Appl.CurrentProject.Connection, adOpenDynamic, adLockOptimistic, adCmdTable
' Determine the count of dates and re-dimension the local array to this count
rsDates.MoveFirst
iDate = 0
Do Until rsDates.EOF
iDate = iDate + 1
rsDates.MoveNext
Loop
iDatesCount = iDate
ReDim Dates(1 To iDatesCount)
' Now store the dates in the local array
rsDates.MoveFirst
iDate = 0
Do Until rsDates.EOF
iDate = iDate + 1
Dates(iDate) = rsDates("FTP_Date").Value
rsDates.MoveNext
Loop
rsDates.Close
' Open a recordset containing the yield curve for each date and store the results in a local array
ReDim YieldCurve(1 To iDatesCount, 1 To 360)
rsRates.Open "qFTP_Rates_Interp", Appl.CurrentProject.Connection, adOpenDynamic, adLockOptimistic, adCmdTable
rsRates.MoveFirst
Do Until rsRates.EOF
' Get info from this record
FTP_Date = rsRates("FTP_Date").Value
FTP_Rate = rsRates("Rate").Value
iMonth = rsRates("Months").Value
' Get Date ID
iDate = Get_FTP_DateID(FTP_Date, Dates, iDatesCount)
' Store in a local array and move to next record
YieldCurve(iDate, iMonth) = FTP_Rate
rsRates.MoveNext
Loop
' Open a recordset containing the COF table and make sure there is data to process
rsCOF.Open "COF_Table", Appl.CurrentProject.Connection, adOpenDynamic, adLockOptimistic, adCmdTable
If rsCOF.BOF And rsCOF.EOF Then ' No records in COF table
VBA.MsgBox "No records found in COF table. First choose a valid source, and then Import before processing."
GoTo Exit_FTP_Calculator
End If
' Get total row count
rsCOF.MoveFirst
iRowCount = 0
Do Until rsCOF.EOF
iRowCount = iRowCount + 1
rsCOF.MoveNext
Loop
iTotalRows = iRowCount
iRowsPerUpdate = iTotalRows / 50
' Loop through each record and perform calculation
rsCOF.MoveFirst
iRowCount = 0
Do Until rsCOF.EOF
iRowCount = iRowCount + 1
' Get info from this record
COF_Product = rsCOF("Product").Value
COF_Date = rsCOF("Date").Value
COF_Rate = rsCOF("Avg Rate").Value
COF_Term = rsCOF("Avg Term").Value
' Get Date ID
iDate = Get_FTP_DateID(COF_Date, Dates, iDatesCount)
If iDate = 0 Then
VBA.MsgBox "Error looking up FTP values for the COF date. Make sure that you have the correct yield curve imported into this tool.", vbCritical, "COF Date Not Found in Yield Curve"
GoTo Exit_FTP_Calculator
End If
' Get Product Code
Select Case COF_Term
Case 1 To 60: iHE_Term = 5
Case 61 To 120: iHE_Term = 10
Case 121 To 180: iHE_Term = 15
Case 181 To 240: iHE_Term = 20
Case 241 To 360: iHE_Term = 30
Case Else: iHE_Term = 5
End Select
sProductDescr = iHE_Term & " Year Term Home Equity Loans"
sCriteria = "[Product_Descr]='" & sProductDescr & "'"
sProductCode = Appl.DLookup("Product_Code", "Product_Codes", sCriteria)
' Get YearMonth
sYearMonth = VBA.Format$(COF_Date, "yyyymm")
' Do base calcs
COF_Base = Get_COF(iDate, COF_Rate, COF_Term, SMM, YieldCurve)
' Determine Treasury premiums; do look-up for "Loans", set to 0 for "DFS"
If COF_Product = "DFS" Then
COF_RateLock = 0
COF_Prepayment = 0
Else
sCriteria = "[Product_Code]='" & sProductCode & "' AND [YearMonth]='" & sYearMonth & "'"
COF_RateLock = Appl.Nz(Appl.DLookup("RateLock_Rate", "Treasury_Premiums", sCriteria), -100) / 100
COF_Prepayment = Appl.Nz(Appl.DLookup("Option_Rate", "Treasury_Premiums", sCriteria), -100) / 100
If COF_RateLock = -1 Then
VBA.MsgBox "Error looking up Treasury Premium values for the COF date. Make sure that you have the Treasury Premiums table imported into this tool.", vbCritical, "COF Date Not Found in Yield Curve"
GoTo Exit_FTP_Calculator
End If
End If
' Store result and move to next record
rsCOF("COF") = COF_Base + COF_RateLock + COF_Prepayment
rsCOF("Base") = COF_Base
rsCOF("RateLock") = COF_RateLock
rsCOF("Prepayment") = COF_Prepayment
rsCOF.Update
rsCOF.MoveNext
' Update the progress bar if RowCount is an integer multiple of iRowsPerUpdate
If VBA.Int(iRowCount / iRowsPerUpdate) * iRowsPerUpdate = iRowCount Then
Appl.Forms("fDataEnvironment")!lblProgressBar.Width = VBA.Int(iRowCount / iTotalRows * iProgressBarWidth)
VBA.DoEvents
End If
Loop
Exit_FTP_Calculator:
Set Appl = Nothing
Set rsRates = Nothing
Set rsDates = Nothing
Set rsCOF = Nothing
Exit Sub 'FTP_Calculator
Err_FTP_Calculator:
Resume Exit_FTP_Calculator
End Sub 'FTP_CalculatorI think it is breaking down here since I get the "Error looking up Treasury Premium values for the COF date. Make sure that you have the Treasury Premiums table imported into this tool" error message:
Code:
' Get Product Code
Select Case COF_Term
Case 1 To 60: iHE_Term = 5
Case 61 To 120: iHE_Term = 10
Case 121 To 180: iHE_Term = 15
Case 181 To 240: iHE_Term = 20
Case 241 To 360: iHE_Term = 30
Case Else: iHE_Term = 5
End Select
sProductDescr = iHE_Term & " Year Term Home Equity Loans"
sCriteria = "[Product_Descr]='" & sProductDescr & "'"
sProductCode = Appl.DLookup("Product_Code", "Product_Codes", sCriteria)
' Get YearMonth
sYearMonth = VBA.Format$(COF_Date, "yyyymm")
' Do base calcs
COF_Base = Get_COF(iDate, COF_Rate, COF_Term, SMM, YieldCurve)
' Determine Treasury premiums; do look-up for "Loans", set to 0 for "DFS"
If COF_Product = "DFS" Then
COF_RateLock = 0
COF_Prepayment = 0
Else
sCriteria = "[Product_Code]='" & sProductCode & "' AND [YearMonth]='" & sYearMonth & "'"
COF_RateLock = Appl.Nz(Appl.DLookup("RateLock_Rate", "Treasury_Premiums", sCriteria), -100) / 100
COF_Prepayment = Appl.Nz(Appl.DLookup("Option_Rate", "Treasury_Premiums", sCriteria), -100) / 100
If COF_RateLock = -1 Then
VBA.MsgBox "Error looking up Treasury Premium values for the COF date. Make sure that you have the Treasury Premiums table imported into this tool.", vbCritical, "COF Date Not Found in Yield Curve"
GoTo Exit_FTP_Calculator
End If
End IfThe Treasury_Premium table is loaded and has all of the records that are needed.
Any help that you all can give is greatly appreciated.
Chris
