Thanks 2 All - My Amortization Code Completed

[Stephen Lynch]

First, I want to say a big thanks to everyone that helped me. I searched
long for code that would process an amortization schedule and append it to a
table, and it needed to include semi-monthly schedule.

In the spirit of sharing, here it is for anyone that needs to generate a
loan schedule in access. Access is a great tool when someone like me who
has no coding education can do this.

Frequency is the no of payments per year, Totpayments are the number of
payments over the life of the loan, startdate is the date 1st payment is to
begin.

****************************************

Function LoanAmort2(BeginPrincipal As Currency, InterestRate As Double,
Frequency As Double, TotPmts As Double, StartDate As Date)

Dim FVal As Double
Dim PayType As Double
Dim Payment As Currency
Dim Period As Integer
Dim P As Currency 'Principal Payment
Dim I As Currency 'Interest Payment
Dim EB As Currency 'Ending Balance
Dim RemainBalance As Currency
Dim PD As Date 'Payment Date
Dim Interval As String
Dim CounterAdj As Integer
Dim AltCounter As Integer
Dim lngYear As Long
Dim lngMonth As Long
Dim lngDay As Long
Dim SecondCase As Integer


Select Case Frequency
Case "52"
Interval = "ww"
CounterAdj = 1
SecondCase = 1
Case "26"
Interval = "ww"
CounterAdj = 2
SecondCase = 1
Case "24"
Interval = "m"
CounterAdj = 1
SecondCase = 2
Case "12"
Interval = "m"
CounterAdj = 1
SecondCase = 1
Case "4"
Interval = "q"
CounterAdj = 1
SecondCase = 1
Case "2"
Interval = "q"
CounterAdj = 2
SecondCase = 1
Case "1"
Interval = "yyyy"
CounterAdj = 1
SecondCase = 1

End Select

'StartDate = Format$(StartDate, "dd/mm/yyyy")
'PD = Format$(PD, "dd/mm/yyyy")

FVal = 0 ' Usually 0 for a loan.
If InterestRate > 1 Then InterestRate = InterestRate / 100 ' Ensure
proper form.
PayType = 0 'Payments made at the beginning of the month

Payment = Abs(-Pmt(InterestRate / Frequency, TotPmts, BeginPrincipal, FVal,
PayType))
RemainBalance = BeginPrincipal

'loop through each payment

For Period = 1 To TotPmts
AltCounter = (Period + 1) \ 2 'double count counter for Semi-Monthly
Calcs
EB = RemainBalance
P = PPmt(InterestRate / Frequency, Period, TotPmts, -BeginPrincipal,
FVal, PayType)
P = (Int((P + 0.005) * 100) / 100) ' Round principal.
I = Payment - P
I = (Int((I + 0.005) * 100) / 100) ' Round interest.

If Frequency <> 24 Then
PD = DateAdd(Interval, (Period * CounterAdj) - CounterAdj, StartDate)

Else
If Frequency = 24 And (Period Mod 2) = 0 Then
PD = DateAdd(Interval, (AltCounter * CounterAdj) - CounterAdj,
StartDate)
lngYear = DatePart("yyyy", PD)
lngMonth = DatePart("m", PD)
lngDay = StartDay(DatePart("d", PD))
If DatePart("d", PD) < 15 Then
PD = DateSerial(lngYear, lngMonth, lngDay)
Else
If DatePart("d", PD) = 15 Then
lngDay = DateSerial(lngYear, lngMonth + 1, 0)
PD = DateSerial(Year(PD), Month(PD) + 1, 0)
Else
PD = DateSerial(lngYear, lngMonth + 1, lngDay)
End If
End If
Else
If Frequency = 24 Then
PD = DateAdd(Interval, (AltCounter * CounterAdj) - CounterAdj,
StartDate)
End If
End If
End If

'PD = DateAdd(Interval, (Period * CounterAdj) - CounterAdj, StartDate)
EB = RemainBalance - P
RemainBalance = EB

DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblLoanGenerateTEMP
(Period,Principal,Interest,PaymentAmt,RemainingBalance,PaymentDueDate)
SELECT (" & Period & ")AS Period,(" & P & ")AS Principal,(" & I & ")AS
Interest,(" & Payment & ")AS PaymentAmt,(" & EB & ")AS RemainingBalance,#" &
PD & "# AS PaymentDueDate"

Next

End Function

***************************************************

Public Function StartDay(X As Date) As Variant

Select Case X
Case "1"
StartDay = "16"
Case "2"
StartDay = "17"
Case "3"
StartDay = "18"
Case "4"
StartDay = "19"
Case "5"
StartDay = "20"
Case "6"
StartDay = "21"
Case "7"
StartDay = "22"
Case "8"
StartDay = "23"
Case "9"
StartDay = "24"
Case "10"
StartDay = "25"
Case "11"
StartDay = "26"
Case "12"
StartDay = "27"
Case "13"
StartDay = "28"
Case "14"
StartDay = "29"
Case "16"
StartDay = "1"
Case "17"
StartDay = "2"
Case "18"
StartDay = "3"
Case "19"
StartDay = "4"
Case "20"
StartDay = "5"
Case "21"
StartDay = "6"
Case "22"
StartDay = "7"
Case "23"
StartDay = "8"
Case "24"
StartDay = "9"
Case "25"
StartDay = "10"
Case "26"
StartDay = "11"
Case "27"
StartDay = "12"

End Select
End Function