none
Populate table from calculation results RRS feed

  • Question

  • I'm creating a template that results in a payment schedule. My code creates the table and puts in the column headings. Then I calculate the payments based on initial balance, payment amount and first payment date. The results will be something like:

    Num   Date            Amount   Balance

    1        3/15/2020    $150.00  $850.00

    2        4/15/2020    $150.00   $700.00

    3        5/15/2020    $150.00   $550.00

    and so on.

    I can generate the values, but what is the best way to populate the table. I'm thinking it's going to fill an array with the results and then use the element positions to populate the table. But..that's where I reach the cul du sac in my knowledge.

    If somebody already knows a better way to do this I'm good with that too.

    Here's my code so far:

                                                                    

    Sub PaymentScheduleTable()
        Dim intNoOfRows
        Dim intNoOfColumns
        Dim objRange
        Dim objTable
        Dim i As Integer
        Dim j As Integer
        Dim Balance As Double
        Dim InitialPayment As Double
        Dim RegularPayment As Double
        Dim FirstPaymentDate As Date
        Dim NumPayments As Integer
        Dim LastPayment As Double
        Dim ReportSheet As Excel.Worksheet

        ThisDocument.Tables(1).Delete

        intNoOfRows = 2
        intNoOfColumns = 4

        Set objRange = ThisDocument.Range
        ThisDocument.Tables.Add objRange, intNoOfRows, intNoOfColumns
        Set objTable = ThisDocument.Tables(1)
        objTable.Borders.Enable = True

        objTable.Cell(1, 1).Range.Text = "Payment Number"
        objTable.Cell(1, 2).Range.Text = "Date"
        objTable.Cell(1, 3).Range.Text = "Amount"
        objTable.Cell(1, 4).Range.Text = "Balance"

        Balance = 5025.25
        InitialPayment = 0
        RegularPayment = 80.25
        FirstPaymentDate = "March 5, 2020"

        If Balance <= 0 Or RegularPayment <= 0 Or FirstPaymentDate <= 0 Then Exit Sub

        NumPayments = WorksheetFunction.RoundUp((Balance / RegularPayment), 0)
        If Int(Balance / RegularPayment) - (Balance / RegularPayment) = 0 Then
            LastPayment = RegularPayment
        Else
            LastPayment = Abs(Int(Balance / RegularPayment) - (Balance / RegularPayment)) * RegularPayment
        End If
        'This is how I do this in Excel

        For i = 1 To NumPayments
            ReportSheet.Cells(i + 6, 1).Value = i
            ReportSheet.Cells(i + 6, 2).Value = DateAdd("m", i - 1, FirstPaymentDate)
            If i = NumPayments Then
                ReportSheet.Cells(i + 6, 3).Value = LastPayment
            Else
                ReportSheet.Cells(i + 6, 3).Value = RegularPayment
            End If
            If i = 1 Then
                ReportSheet.Cells(i + 6, 4).Value = Balance - RegularPayment
            Else
                ReportSheet.Cells(i + 6, 4) = ReportSheet.Cells(i + 5, 4) - ReportSheet.Cells(i + 6, 3)
            End If
        Next i

    'This is where I left off



    End Sub



    Thursday, February 27, 2020 8:04 PM

All replies

  • I've moved thigs around more than I usually would, but the code would be quite similar - the following should illustrate some of the things you need to think about. Not sure whether you would still be getting some of the info from a Worksheet, but I leave you to work that out.

    For reasonably small numbers of rows, this approach should execute quite quickly. For much larger row counts you may need to consider other possibilities, e.g. create a Range to insert the data, inserting each row into the Range as a tab-delimited paragraph, use Range.ConvertToTable to create the table, then format it as required.


    Option Explicit
    Sub PaymentScheduleTable() Dim intNoOfRows As Integer Dim intNoOfColumns As Integer Dim intOffset As Integer Dim objDocument As Word.Document Dim objRange As Word.Range Dim objTable As Word.Table Dim i As Integer Dim j As Integer Dim Balance As Double Dim Previous As Double Dim ThisPayment As Double Dim InitialPayment As Double Dim RegularPayment As Double Dim FirstPaymentDate As Date Dim NumPayments As Integer Dim LastPayment As Double 'Dim ReportSheet As Excel.Worksheet Balance = 5025.25 InitialPayment = 0 RegularPayment = 80.25 FirstPaymentDate = "March 5, 2020" ' I don't have your worksheet, so make a number up NumPayments = 6 'NumPayments = WorksheetFunction.RoundUp((Balance / RegularPayment), 0) If Int(Balance / RegularPayment) - (Balance / RegularPayment) = 0 Then LastPayment = RegularPayment Else LastPayment = Abs(Int(Balance / RegularPayment) - (Balance / RegularPayment)) * RegularPayment End If If Balance <= 0 Or RegularPayment <= 0 Or FirstPaymentDate <= 0 Then intNoOfRows = 1 Else intNoOfRows = NumPayments End If intNoOfColumns = 4 intOffset = 1 ' just in case you still need this - in your code it would be 6 Previous = Balance With ThisDocument If .Tables.Count > 0 Then Set objRange = .Tables(1).Range .Tables(1).Delete ' or instead of the following two lines you could use ' With .Tables.Add(objRange, intNoOfRows, intNoOfColumns) ' but keeping two separate lines can make debugging easier Set objTable = .Tables.Add(objRange, intNoOfRows + intOffset, intNoOfColumns) With objTable .Borders.Enable = True .Cell(1, 1).Range.Text = "Payment Number" .Cell(1, 2).Range.Text = "Date" .Cell(1, 3).Range.Text = "Amount" .Cell(1, 4).Range.Text = "Balance" For i = 1 To NumPayments .Cell(i + intOffset, 1).Range.Text = CStr(i) .Cell(i + intOffset, 2).Range.Text = Format(DateAdd("m", i - 1, FirstPaymentDate), "Mmmm D, YYYY") If i = NumPayments Then ThisPayment = LastPayment Else ThisPayment = RegularPayment End If .Cell(i + intOffset, 3).Range.Text = Format(ThisPayment, "Standard") If i = 1 Then Previous = Previous - RegularPayment Else Previous = Previous - ThisPayment End If .Cell(i + intOffset, 4).Range.Text = Format(Previous, "Standard") Next i End With End If End With End Sub



    Peter Jamieson

    Friday, February 28, 2020 9:55 AM