Macro to calculate billing schedule?

[jmthompson]

Good afternoon,
I have just been passed a new VBA project and there is one component I would like help with.

Column J lists a start date
Column K lists an end date
Column N lists a dollar amount.
Columns P through the last column has headers of month-year in text form(for example May-08)

The user enters contract information in the spreadsheet including the above cells. What they want to automate is once the user enters the contract information on a given row, she runs a macro to determine the billing schedule by calculating how many months there are between the start and end dates, divide the dollar amount in column N by that number and then prompt the user to enter what month the first payment is due, once that is entered, the macro should place the payment amount in that column and all applicable subsequent columns.

For example,
Column J = 6/1/2008
Column K = 9/1/2008
Column N = 3,000
The macro should calculate 3 months, the monthly payment amount is $1000.
A starting month prompt appears and the user enters July-08. The macro then places 1,000 in the columns for July-08, August-08 and September-08.

Is such a thing possible?

 

[CharlesH]

Hi,

Paste this code to sheet1 code module.
Right click the sheet tab that has the data you want to change. Select "View Code"
Then paste.
The start date I'm assuming will be for the start date for the payment.
The code works after the user inputs a $ amount. This amount will be divide by 3 and then
the amounts should be placed in the correct months.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Mycol As Integer
Dim cnt As Integer
Dim cell As Range
Dim MyStartdate As String
Dim Myamount As String, MysubAmt As String
Mycol = Target.Column
If Mycol = 14 Then '' column that the $ amount is in.
    Myamount = Cells(Target.Row, 14)
    MyStartdate = Cells(Target.Row, 10)
    For i = 1 To 3
    Mytime = DateSerial(Year(MyStartdate), Month(MyStartdate) + cnt, Day(MyStartdate))
    
        MysubAmt = Myamount / 3
        For Each cell In Range("P1:V1")
            If cell.Value = Mytime Then
            Application.ScreenUpdating = False
                Cells(Target.Row, cell.Column).Value = MysubAmt
                cnt = cnt + 1
                Application.ScreenUpdating = True
            End If
        Next cell
    Next i
End If

End Sub