Asked by:
Populate table from calculation results
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 ExcelFor 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
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 tabdelimited 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