Hi
I'm pretty new to VBA and I am trying to do something new in it, a recipe for disaster.
First off, I am using Excel 2010 and windows 7 64-bit.
I am trying to copy an excel table into a word doc. This table changes sizes depending on user inputs and won't always fit on one page of a word doc. Because of this I have multiple copy and past lines. The program works in break mode, stepping through it, but it errors out when I run it. The line of code causing the error is
objDoc.Selection.PasteExcelTable False, False, True
The error I get is
"Run-time error '4605': This method or property is not available because the current selection is at the end of a table row"
I looked online but couldn't find information on this error that seemed to match my problem.
The line of code works in some parts of my code but causes errors in others.
I have tried using
which gives an infinite loop as the error doesn't resolve
I have also tried pausing the execution of the program before the line thinking that word needed time to catch up but that didn't do anything.
Here is the table I am working with
Excel 2010
<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]3[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]4[/TD]
[TD="bgcolor: #D2CE97"]Loan Details[/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="align: center"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: center"]6[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: center"]7[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: center"]8[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: center"]9[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: center"]10[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: center"]11[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]12[/TD]
[TD="bgcolor: #D2CE97"]Address[/TD]
[TD="bgcolor: #D2CE97"]402 2nd Ave, Beaver Mines[/TD]
[TD="bgcolor: #D2CE97"]698 Lacombe St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]717 Schofield St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]707 Schofield St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]891 Dundas St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]16 Castleview Ridge Estates[/TD]
[TD="bgcolor: #D2CE97"]718 McDougall St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]1109 Hewetson Ave, Pincher Creek[/TD]
[TD="align: center"]13[/TD]
[TD="align: right"]$425,000.00[/TD]
[TD="align: right"]$199,900.00[/TD]
[TD="align: right"]$199,900.00[/TD]
[TD="align: right"]$254,900.00[/TD]
[TD="align: right"]$318,900.00[/TD]
[TD="align: right"]$254,000.00[/TD]
[TD="align: right"]$179,900.00[/TD]
[TD="align: right"]$169,900.00[/TD]
[TD="align: center"]14[/TD]
[TD="align: right"]$15,937.50[/TD]
[TD="align: right"]$7,496.25[/TD]
[TD="align: right"]$7,496.25[/TD]
[TD="align: right"]$9,558.75[/TD]
[TD="align: right"]$11,958.75[/TD]
[TD="align: right"]$9,525.00[/TD]
[TD="align: right"]$6,746.25[/TD]
[TD="align: right"]$6,371.25[/TD]
[TD="align: center"]15[/TD]
[TD="align: right"]$3,825.00[/TD]
[TD="align: right"]$1,399.30[/TD]
[TD="align: right"]$1,199.40[/TD]
[TD="align: right"]$1,784.30[/TD]
[TD="align: right"]$2,551.20[/TD]
[TD="align: right"]$1,778.00[/TD]
[TD="align: right"]$1,079.40[/TD]
[TD="align: right"]$1,359.20[/TD]
[TD="align: center"]16[/TD]
[TD="align: right"]$444,762.50[/TD]
[TD="align: right"]$208,795.55[/TD]
[TD="align: right"]$208,595.65[/TD]
[TD="align: right"]$266,243.05[/TD]
[TD="align: right"]$333,409.95[/TD]
[TD="align: right"]$265,303.00[/TD]
[TD="align: right"]$187,725.65[/TD]
[TD="align: right"]$177,630.45[/TD]
[TD="align: center"]17[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]18[/TD]
[TD="align: right"]$444,762.50[/TD]
[TD="align: right"]$196,997.20[/TD]
[TD="align: right"]$196,787.31[/TD]
[TD="align: right"]$257,317.08[/TD]
[TD="align: right"]$327,842.32[/TD]
[TD="align: right"]$256,330.03[/TD]
[TD="align: right"]$174,873.81[/TD]
[TD="align: right"]$164,273.85[/TD]
[TD="align: center"]19[/TD]
[TD="align: right"]$7,981.92[/TD]
[TD="align: right"]$3,535.41[/TD]
[TD="align: right"]$3,531.64[/TD]
[TD="align: right"]$4,617.94[/TD]
[TD="align: right"]$5,883.62[/TD]
[TD="align: right"]$4,600.22[/TD]
[TD="align: right"]$3,138.37[/TD]
[TD="align: right"]$2,948.14[/TD]
[TD="align: center"]20[/TD]
[TD="align: right"]$495.83[/TD]
[TD="align: right"]$166.58[/TD]
[TD="align: right"]$199.90[/TD]
[TD="align: right"]$254.90[/TD]
[TD="align: right"]$345.48[/TD]
[TD="align: right"]$338.67[/TD]
[TD="align: right"]$149.92[/TD]
[TD="align: right"]$169.90[/TD]
[TD="align: center"]21[/TD]
[TD="align: right"]$798.19[/TD]
[TD="align: right"]$247.48[/TD]
[TD="align: right"]$317.85[/TD]
[TD="align: right"]$369.43[/TD]
[TD="align: right"]$470.69[/TD]
[TD="align: right"]$460.02[/TD]
[TD="align: right"]$219.69[/TD]
[TD="align: right"]$235.85[/TD]
[TD="align: center"]22[/TD]
[TD="bgcolor: #E2988B, align: right"]$9,275.95[/TD]
[TD="bgcolor: #E2988B, align: right"]$3,949.47[/TD]
[TD="bgcolor: #E2988B, align: right"]$4,049.39[/TD]
[TD="bgcolor: #E2988B, align: right"]$5,242.27[/TD]
[TD="bgcolor: #E2988B, align: right"]$6,699.78[/TD]
[TD="bgcolor: #E2988B, align: right"]$5,398.91[/TD]
[TD="bgcolor: #E2988B, align: right"]$3,507.97[/TD]
[TD="bgcolor: #E2988B, align: right"]$3,353.89[/TD]
[TD="align: center"]23[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]24[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]25[/TD]
[TD="align: right"]$133,549.49[/TD]
[TD="align: right"]$69,631.74[/TD]
[TD="align: right"]$70,830.77[/TD]
[TD="align: right"]$85,145.37[/TD]
[TD="align: right"]$102,635.48[/TD]
[TD="align: right"]$87,025.05[/TD]
[TD="align: right"]$64,333.79[/TD]
[TD="align: right"]$62,484.78[/TD]
[TD="align: center"]26[/TD]
[TD="align: right"]$516,867.20[/TD]
[TD="align: right"]$220,069.24[/TD]
[TD="align: right"]$225,636.84[/TD]
[TD="align: right"]$292,105.79[/TD]
[TD="align: right"]$373,320.00[/TD]
[TD="align: right"]$300,833.95[/TD]
[TD="align: right"]$195,468.52[/TD]
[TD="align: right"]$186,882.79[/TD]
</tbody>
I've included the entire sub with the problem lines noted. Please don't judge me for my poor coding.
I appreciate any help.
Option Explicit
Sub CreateWordDoc1()
'<<<<the microsoft="" word="" object="" library="" must="" be="" selected="" in="" the="" references.="">>>>></the>
Dim objDoc As Object, i As Integer, columnCount As Integer, j As Integer
Dim wrdDoc As Object
****Set objDoc = CreateObject("Word.Application")
******************objDoc.Visible = True
****Set wrdDoc = objDoc.documents.Add
****
****If objDoc.Selection.PageSetup.Orientation = wdOrientPortrait Then
********objDoc.Selection.PageSetup.Orientation = wdOrientLandscape
****Else
********objDoc.Selection.PageSetup.Orientation = wdOrientPortrait
****End If
******************
****objDoc.Selection.TypeText Text:=wsCalculations.Range("B2").Value
********With objDoc
************.Selection.MoveLeft Unit:=wdCharacter, Count:=24, Extend:=wdExtend
************.Selection.MoveRight Unit:=wdCharacter, Count:=1
********End With
********
****objDoc.Selection.TypeParagraph
****objDoc.Selection.TypeText Text:="Loan Details"
****With objDoc
********.Selection.MoveLeft Unit:=wdCharacter, Count:=12, Extend:=wdExtend
********.Selection.MoveRight Unit:=wdCharacter, Count:=1
****End With
****
****objDoc.Selection.TypeParagraph
****
****With wsCalculations
********columnCount = .Range(.Range("B5"), .Range("B5").End(xlToRight)).Columns.Count - 1
********
********j = 1
********If columnCount > 4 Then
************Do While columnCount > 4
****************
****************'Grab the data headings
****************With .Range("B5")
********************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
****************
****************objDoc.Selection.PasteExcelTable False, False, True
****************Application.CutCopyMode = False
****************
****************'reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
****************
****************'this will clear the undo cache in word which will stop these actions from
****************'being reversed by a user
****************wrdDoc.UndoClear
**************
****************With .Range("B5")
********************Range(.Offset(0, j), .Offset(0, j).End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown).Offset(0, 3)).Copy
****************End With
****************
****************Call WaitPeriod
****************'On Error GoTo Paste_Error
****************
'<<<<<<<<< The code errors out on the next line in run mode but it steps through fine in break mode >>>>
****************objDoc.Selection.PasteExcelTable False, False, True
****************
****************Application.CutCopyMode = False
****************
****************'On Error GoTo 0
**************
****************objDoc.Selection.MoveDown Unit:=wdLine, Count:=23
****************objDoc.Selection.InsertBreak Type:=wdPageBreak
****************objDoc.Selection.TypeText Text:="Loan Details"
****************
****************objDoc.Selection.TypeParagraph
****************
****************j = j + 4
****************columnCount = columnCount - 4
****************wrdDoc.UndoClear
************Loop
************
********
********** If columnCount = 1 Then
****************'Grab the rest of the data headings
****************With .Range("B5")
********************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
**************
****************objDoc.Selection.PasteExcelTable False, False, True
****************Application.CutCopyMode = False
****************
****************'Format table and reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveRight Unit:=wdCharacter, Count:=1
********************.Selection.MoveUp Unit:=wdLine, Count:=1
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
****************
****************wrdDoc.UndoClear
****************
****************'Grab the rest of the data
****************With .Range("B5")
********************Range(.Offset(0, j), .Offset(0, j).End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
****************
************Else
****************'Grab the rest of the data headings
****************With .Range("B5")
********************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
**************
****************objDoc.Selection.PasteExcelTable False, False, True
****************Application.CutCopyMode = False
**************
************
****************'reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
************
****************wrdDoc.UndoClear
****************
****************With .Range("B5")
********************Range(.Offset(0, j), .Offset(0, j).End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown).End(xlToRight)).Copy
****************End With
****************
************End If
************
************Call WaitPeriod
************'On Error GoTo Paste_Error
************
'<<<<<<<<< The code errors out on the next line in run mode but it steps through fine in break mode >>>>
************objDoc.Selection.PasteExcelTable False, False, True
************
************Application.CutCopyMode = False
************'On Error GoTo 0
************
********Else
************With .Range("B5")
****************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
************End With
**********
************objDoc.Selection.PasteExcelTable False, False, True
************Application.CutCopyMode = False
**********
************
************'reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveUp Unit:=wdLine, Count:=1
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
************
************wrdDoc.UndoClear
************
************'Put the comparison details in the Word Doc
************.Range(.Range("B5"), .Range("B5").End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown).End(xlToRight)).Copy
********** Call WaitPeriod
********** 'On Error GoTo Paste_Error
************objDoc.Selection.PasteExcelTable False, False, True
************Application.CutCopyMode = False
************'On Error GoTo 0
************
********End If
****End With
****
****
****On Error GoTo Error_Handler
****'this will handle the case where the user wants to save multiple reports
****'or runs two in a row with out deleteing one
****i = 0
****objDoc.ActiveDocument.SaveAs ThisWorkbook.Path & "/" & "Home Comparison Report.docx"
****
****wrdDoc.UndoClear
****Application.CutCopyMode = False
****
****
****Exit Sub
Error_Handler:
****If Err <> 0 Then
****i = i + 1
********objDoc.ActiveDocument.SaveAs ThisWorkbook.Path & "/" & "Home Comparison Report " & i & ".docx"
********'objDoc.documents.Close
****End If
****
Paste_Error:
****'tried to ignore the error
****'Wait Period
****'Err.Clear
****'Resume
End Sub
Sub WaitPeriod()
**** 'Tried slowing down the execution of the command but the error still happens
****Application.Wait Now + TimeValue("00:00:01")
End Sub
I'm sorry it's so long, but I thought it might help someone to help me.
Thank you in advance
I'm pretty new to VBA and I am trying to do something new in it, a recipe for disaster.
First off, I am using Excel 2010 and windows 7 64-bit.
I am trying to copy an excel table into a word doc. This table changes sizes depending on user inputs and won't always fit on one page of a word doc. Because of this I have multiple copy and past lines. The program works in break mode, stepping through it, but it errors out when I run it. The line of code causing the error is
objDoc.Selection.PasteExcelTable False, False, True
The error I get is

I looked online but couldn't find information on this error that seemed to match my problem.
The line of code works in some parts of my code but causes errors in others.
I have tried using
Code:
on error goto
err.clear
Resume
which gives an infinite loop as the error doesn't resolve
I have also tried pausing the execution of the program before the line thinking that word needed time to catch up but that didn't do anything.
Here is the table I am working with
Excel 2010
B | C | D | E | F | G | H | I | J | |
---|---|---|---|---|---|---|---|---|---|
Home Comparison Report | |||||||||
Amortization | |||||||||
Interest Rate | |||||||||
Monthly Payments per Year | |||||||||
Realtor Fees | |||||||||
GST | |||||||||
Down Payment | |||||||||
List Price | |||||||||
Realtor Fees | |||||||||
Legal Fees | |||||||||
Total Price | |||||||||
Loan Amount | |||||||||
Reccuring Loan Payment | |||||||||
Monthly Portion of Property Tax | |||||||||
Monthly Mortgage Insurance | |||||||||
Total Monthly Mortgage Payment | |||||||||
Total Cost of Ownership in 1st Year | |||||||||
Present Value of all Ownership Costs |
<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]3[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]4[/TD]
[TD="bgcolor: #D2CE97"]Loan Details[/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="bgcolor: #D2CE97, align: right"][/TD]
[TD="align: center"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: center"]6[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: right"]2.95%[/TD]
[TD="align: center"]7[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]12[/TD]
[TD="align: center"]8[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: right"]3.75%[/TD]
[TD="align: center"]9[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: right"]5.00%[/TD]
[TD="align: center"]10[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: right"]$22,238.13[/TD]
[TD="align: center"]11[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]12[/TD]
[TD="bgcolor: #D2CE97"]Address[/TD]
[TD="bgcolor: #D2CE97"]402 2nd Ave, Beaver Mines[/TD]
[TD="bgcolor: #D2CE97"]698 Lacombe St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]717 Schofield St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]707 Schofield St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]891 Dundas St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]16 Castleview Ridge Estates[/TD]
[TD="bgcolor: #D2CE97"]718 McDougall St, Pincher Creek[/TD]
[TD="bgcolor: #D2CE97"]1109 Hewetson Ave, Pincher Creek[/TD]
[TD="align: center"]13[/TD]
[TD="align: right"]$425,000.00[/TD]
[TD="align: right"]$199,900.00[/TD]
[TD="align: right"]$199,900.00[/TD]
[TD="align: right"]$254,900.00[/TD]
[TD="align: right"]$318,900.00[/TD]
[TD="align: right"]$254,000.00[/TD]
[TD="align: right"]$179,900.00[/TD]
[TD="align: right"]$169,900.00[/TD]
[TD="align: center"]14[/TD]
[TD="align: right"]$15,937.50[/TD]
[TD="align: right"]$7,496.25[/TD]
[TD="align: right"]$7,496.25[/TD]
[TD="align: right"]$9,558.75[/TD]
[TD="align: right"]$11,958.75[/TD]
[TD="align: right"]$9,525.00[/TD]
[TD="align: right"]$6,746.25[/TD]
[TD="align: right"]$6,371.25[/TD]
[TD="align: center"]15[/TD]
[TD="align: right"]$3,825.00[/TD]
[TD="align: right"]$1,399.30[/TD]
[TD="align: right"]$1,199.40[/TD]
[TD="align: right"]$1,784.30[/TD]
[TD="align: right"]$2,551.20[/TD]
[TD="align: right"]$1,778.00[/TD]
[TD="align: right"]$1,079.40[/TD]
[TD="align: right"]$1,359.20[/TD]
[TD="align: center"]16[/TD]
[TD="align: right"]$444,762.50[/TD]
[TD="align: right"]$208,795.55[/TD]
[TD="align: right"]$208,595.65[/TD]
[TD="align: right"]$266,243.05[/TD]
[TD="align: right"]$333,409.95[/TD]
[TD="align: right"]$265,303.00[/TD]
[TD="align: right"]$187,725.65[/TD]
[TD="align: right"]$177,630.45[/TD]
[TD="align: center"]17[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]18[/TD]
[TD="align: right"]$444,762.50[/TD]
[TD="align: right"]$196,997.20[/TD]
[TD="align: right"]$196,787.31[/TD]
[TD="align: right"]$257,317.08[/TD]
[TD="align: right"]$327,842.32[/TD]
[TD="align: right"]$256,330.03[/TD]
[TD="align: right"]$174,873.81[/TD]
[TD="align: right"]$164,273.85[/TD]
[TD="align: center"]19[/TD]
[TD="align: right"]$7,981.92[/TD]
[TD="align: right"]$3,535.41[/TD]
[TD="align: right"]$3,531.64[/TD]
[TD="align: right"]$4,617.94[/TD]
[TD="align: right"]$5,883.62[/TD]
[TD="align: right"]$4,600.22[/TD]
[TD="align: right"]$3,138.37[/TD]
[TD="align: right"]$2,948.14[/TD]
[TD="align: center"]20[/TD]
[TD="align: right"]$495.83[/TD]
[TD="align: right"]$166.58[/TD]
[TD="align: right"]$199.90[/TD]
[TD="align: right"]$254.90[/TD]
[TD="align: right"]$345.48[/TD]
[TD="align: right"]$338.67[/TD]
[TD="align: right"]$149.92[/TD]
[TD="align: right"]$169.90[/TD]
[TD="align: center"]21[/TD]
[TD="align: right"]$798.19[/TD]
[TD="align: right"]$247.48[/TD]
[TD="align: right"]$317.85[/TD]
[TD="align: right"]$369.43[/TD]
[TD="align: right"]$470.69[/TD]
[TD="align: right"]$460.02[/TD]
[TD="align: right"]$219.69[/TD]
[TD="align: right"]$235.85[/TD]
[TD="align: center"]22[/TD]
[TD="bgcolor: #E2988B, align: right"]$9,275.95[/TD]
[TD="bgcolor: #E2988B, align: right"]$3,949.47[/TD]
[TD="bgcolor: #E2988B, align: right"]$4,049.39[/TD]
[TD="bgcolor: #E2988B, align: right"]$5,242.27[/TD]
[TD="bgcolor: #E2988B, align: right"]$6,699.78[/TD]
[TD="bgcolor: #E2988B, align: right"]$5,398.91[/TD]
[TD="bgcolor: #E2988B, align: right"]$3,507.97[/TD]
[TD="bgcolor: #E2988B, align: right"]$3,353.89[/TD]
[TD="align: center"]23[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]24[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]25[/TD]
[TD="align: right"]$133,549.49[/TD]
[TD="align: right"]$69,631.74[/TD]
[TD="align: right"]$70,830.77[/TD]
[TD="align: right"]$85,145.37[/TD]
[TD="align: right"]$102,635.48[/TD]
[TD="align: right"]$87,025.05[/TD]
[TD="align: right"]$64,333.79[/TD]
[TD="align: right"]$62,484.78[/TD]
[TD="align: center"]26[/TD]
[TD="align: right"]$516,867.20[/TD]
[TD="align: right"]$220,069.24[/TD]
[TD="align: right"]$225,636.84[/TD]
[TD="align: right"]$292,105.79[/TD]
[TD="align: right"]$373,320.00[/TD]
[TD="align: right"]$300,833.95[/TD]
[TD="align: right"]$195,468.52[/TD]
[TD="align: right"]$186,882.79[/TD]
</tbody>
Report
I've included the entire sub with the problem lines noted. Please don't judge me for my poor coding.
I appreciate any help.
Option Explicit
Sub CreateWordDoc1()
'<<<<the microsoft="" word="" object="" library="" must="" be="" selected="" in="" the="" references.="">>>>></the>
Dim objDoc As Object, i As Integer, columnCount As Integer, j As Integer
Dim wrdDoc As Object
****Set objDoc = CreateObject("Word.Application")
******************objDoc.Visible = True
****Set wrdDoc = objDoc.documents.Add
****
****If objDoc.Selection.PageSetup.Orientation = wdOrientPortrait Then
********objDoc.Selection.PageSetup.Orientation = wdOrientLandscape
****Else
********objDoc.Selection.PageSetup.Orientation = wdOrientPortrait
****End If
******************
****objDoc.Selection.TypeText Text:=wsCalculations.Range("B2").Value
********With objDoc
************.Selection.MoveLeft Unit:=wdCharacter, Count:=24, Extend:=wdExtend
************.Selection.MoveRight Unit:=wdCharacter, Count:=1
********End With
********
****objDoc.Selection.TypeParagraph
****objDoc.Selection.TypeText Text:="Loan Details"
****With objDoc
********.Selection.MoveLeft Unit:=wdCharacter, Count:=12, Extend:=wdExtend
********.Selection.MoveRight Unit:=wdCharacter, Count:=1
****End With
****
****objDoc.Selection.TypeParagraph
****
****With wsCalculations
********columnCount = .Range(.Range("B5"), .Range("B5").End(xlToRight)).Columns.Count - 1
********
********j = 1
********If columnCount > 4 Then
************Do While columnCount > 4
****************
****************'Grab the data headings
****************With .Range("B5")
********************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
****************
****************objDoc.Selection.PasteExcelTable False, False, True
****************Application.CutCopyMode = False
****************
****************'reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
****************
****************'this will clear the undo cache in word which will stop these actions from
****************'being reversed by a user
****************wrdDoc.UndoClear
**************
****************With .Range("B5")
********************Range(.Offset(0, j), .Offset(0, j).End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown).Offset(0, 3)).Copy
****************End With
****************
****************Call WaitPeriod
****************'On Error GoTo Paste_Error
****************
'<<<<<<<<< The code errors out on the next line in run mode but it steps through fine in break mode >>>>
****************objDoc.Selection.PasteExcelTable False, False, True
****************
****************Application.CutCopyMode = False
****************
****************'On Error GoTo 0
**************
****************objDoc.Selection.MoveDown Unit:=wdLine, Count:=23
****************objDoc.Selection.InsertBreak Type:=wdPageBreak
****************objDoc.Selection.TypeText Text:="Loan Details"
****************
****************objDoc.Selection.TypeParagraph
****************
****************j = j + 4
****************columnCount = columnCount - 4
****************wrdDoc.UndoClear
************Loop
************
********
********** If columnCount = 1 Then
****************'Grab the rest of the data headings
****************With .Range("B5")
********************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
**************
****************objDoc.Selection.PasteExcelTable False, False, True
****************Application.CutCopyMode = False
****************
****************'Format table and reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveRight Unit:=wdCharacter, Count:=1
********************.Selection.MoveUp Unit:=wdLine, Count:=1
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
****************
****************wrdDoc.UndoClear
****************
****************'Grab the rest of the data
****************With .Range("B5")
********************Range(.Offset(0, j), .Offset(0, j).End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
****************
************Else
****************'Grab the rest of the data headings
****************With .Range("B5")
********************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
**************
****************objDoc.Selection.PasteExcelTable False, False, True
****************Application.CutCopyMode = False
**************
************
****************'reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
************
****************wrdDoc.UndoClear
****************
****************With .Range("B5")
********************Range(.Offset(0, j), .Offset(0, j).End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown).End(xlToRight)).Copy
****************End With
****************
************End If
************
************Call WaitPeriod
************'On Error GoTo Paste_Error
************
'<<<<<<<<< The code errors out on the next line in run mode but it steps through fine in break mode >>>>
************objDoc.Selection.PasteExcelTable False, False, True
************
************Application.CutCopyMode = False
************'On Error GoTo 0
************
********Else
************With .Range("B5")
****************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
************End With
**********
************objDoc.Selection.PasteExcelTable False, False, True
************Application.CutCopyMode = False
**********
************
************'reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveUp Unit:=wdLine, Count:=1
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
************
************wrdDoc.UndoClear
************
************'Put the comparison details in the Word Doc
************.Range(.Range("B5"), .Range("B5").End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown).End(xlToRight)).Copy
********** Call WaitPeriod
********** 'On Error GoTo Paste_Error
************objDoc.Selection.PasteExcelTable False, False, True
************Application.CutCopyMode = False
************'On Error GoTo 0
************
********End If
****End With
****
****
****On Error GoTo Error_Handler
****'this will handle the case where the user wants to save multiple reports
****'or runs two in a row with out deleteing one
****i = 0
****objDoc.ActiveDocument.SaveAs ThisWorkbook.Path & "/" & "Home Comparison Report.docx"
****
****wrdDoc.UndoClear
****Application.CutCopyMode = False
****
****
****Exit Sub
Error_Handler:
****If Err <> 0 Then
****i = i + 1
********objDoc.ActiveDocument.SaveAs ThisWorkbook.Path & "/" & "Home Comparison Report " & i & ".docx"
********'objDoc.documents.Close
****End If
****
Paste_Error:
****'tried to ignore the error
****'Wait Period
****'Err.Clear
****'Resume
End Sub
Sub WaitPeriod()
**** 'Tried slowing down the execution of the command but the error still happens
****Application.Wait Now + TimeValue("00:00:01")
End Sub
I'm sorry it's so long, but I thought it might help someone to help me.
Thank you in advance