How to make my VBA code do nothing AND move to next step / VBA Run time error 91

Question

I am having a problem with the result of my code: Main idea is that i have a word template where i copy paste different tables from an excel file. The tables are in 12 different sheets, named Table 1, Table 2, etc. When there is some data in these sheets, the code works perfectly. This is the entire code:

Sub CreateBasicWordReport()
'Create word doc automatically
Dim wApp As Word.Application
Dim SaveName As String

Set wApp = New Word.Application

With wApp

'Make word visible

.Visible = True
.Activate
.Documents.Add "C:\Users\MyDesktop\TemplateWordFile.dotx"

'paste supplier name in word
Sheets("Sheet1").Range("C1").Copy
.Selection.Goto what:=wdGoToBookmark, name:="SupplierName"
.Selection.PasteSpecial DataType:=wdPasteText

'Dynamic range

Dim Table1 As Worksheet
Dim Table2 As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set Table1 = Worksheets("Table 1")
Set Table2 = Worksheets("Table 2")
Set StartCell = Range("A1")

'Paste table 1 in word

Worksheets("Table 1").UsedRange
LastRow = Table1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Table1.Range("A1:J" & LastRow).Copy
.Selection.GoTo what:=wdGoToBookmark, name:="Table1"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdAlignRowLeft, DisplayAsIcon:=True

'Paste table 2 in word

Worksheets("Table 2").UsedRange
LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Worksheets("Table 2").Range("A1:J" & LastRow).Copy
.Selection.GoTo what:=wdGoToBookmark, name:="Table2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdAlignRowLeft, DisplayAsIcon:=True

'Save doc to a specific location and with a specific title

Dim name As String
name = "C:\Users\MyDesktop\Supplier\" & "DocName" & "_" & _
Sheets("Sheet1").Range("C1").Value & "_" & Sheets("Sheet1").Range("H1").Value & _
"_" & Format(Now, "yyyy-mm-dd") & ".docx"

.ActiveDocument.SaveAs2 Filename:=name
End With
End Sub

The problem is when the sheets are blank. I might only need one table (from sheet Table 1) and IF next sheet (Table 2) is empty, then I want VBA to do nothing and move to the next step. But then i get run time error 91 in this line of my code:

 LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

I have tried the "on error resume next" command, like this:

'Paste table 2 in word

Worksheets("Table 2").UsedRange
On Error Resume Next
LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Worksheets("Table 2").Range("A1:J" & LastRow).Copy
.Selection.GoTo what:=wdGoToBookmark, name:="Table2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdAlignRowLeft, DisplayAsIcon:=True   

BUT in that case, it does bring to my word file an empty table (five lines, 10 rows that have nothing in, just the outline of a table), while I just want it to be blank/nothing appear on my word file.

Does anybody have any idea how this could be solved pretty please?

Answer 1

You could probably just add the If Not IsEmpty(Table1.UsedRange) Then statements to your code. This will prevent the code to run if the worksheet is completely empty. Please comment if you need more help.

Sub CreateBasicWordReport()
'Create word doc automatically
Dim wApp As Word.Application
Dim SaveName As String

Set wApp = New Word.Application

With wApp

'Make word visible

.Visible = True
.Activate
.Documents.Add "C:\Users\MyDesktop\TemplateWordFile.dotx"

'paste supplier name in word
Sheets("Sheet1").Range("C1").Copy
.Selection.Goto what:=wdGoToBookmark, name:="SupplierName"
.Selection.PasteSpecial DataType:=wdPasteText

'Dynamic range

Dim Table1 As Worksheet
Dim Table2 As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set Table1 = Worksheets("Table 1")
Set Table2 = Worksheets("Table 2")
Set StartCell = Range("A1")

'Paste table 1 in word

If Not IsEmpty(Table1.UsedRange) Then
  LastRow = Table1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  Table1.Range("A1:J" & LastRow).Copy
  .Selection.GoTo what:=wdGoToBookmark, name:="Table1"
  .Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
  Placement:=wdAlignRowLeft, DisplayAsIcon:=True
End If

'Paste table 2 in word

If Not IsEmpty(Table2.UsedRange) Then
  LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  Table2.Range("A1:J" & LastRow).Copy
  .Selection.GoTo what:=wdGoToBookmark, name:="Table2"
  .Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
  Placement:=wdAlignRowLeft, DisplayAsIcon:=True
End If

'Save doc to a specific location and with a specific title

Dim name As String
name = "C:\Users\MyDesktop\Supplier\" & "DocName" & "_" & _
Sheets("Sheet1").Range("C1").Value & "_" & Sheets("Sheet1").Range("H1").Value & _
"_" & Format(Now, "yyyy-mm-dd") & ".docx"

.ActiveDocument.SaveAs2 Filename:=name
End With
End Sub

Answer 2

Unfortunately I'm not able to comment on Fabian's answer, but his suggestion will probably solve your problem. I just thought you should know that what your code is doing on "On Error Resume Next" is go to the next line, no matter if there is an error or not . Therefore, in order to tell the program to do something different in case there is an error, you'd have to verify if the error occurred and handle it.

Answer 3

you could avoid some code repetition and widen your code application by delegating tables cpying/pasting to a specific sub:

Sub PasteTables(docContent As Word.Range, numTables As Long)
    Dim iTable As Long
    Dim myRng As Range

    With docContent
        For iTable = 1 To numTables
            Set myRng = Worksheets("Table " & iTable).UsedRange
            If Not IsEmpty(myRng) Then
                myRng.Copy
                .Goto(what:=wdGoToBookmark, name:="Table" & iTable).PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
                Placement:=wdAlignRowLeft, DisplayAsIcon:=True
                Application.CutCopyMode = False
            End If
        Next iTable
    End With
End Sub

correspondingly your main code would shorten down to:

Option Explicit

Sub CreateBasicWordReport()
    'Create word doc automatically
    Dim wApp As Word.Application
    Dim name As String

    Set wApp = New Word.Application

    sheets("Sheet01").Range("C1").Copy
    With wApp.Documents.Add("C:\Users\MyDesktop\TemplateWordFile.dotx") '<-- open word document and reference it        
        'Make word visible
        .Parent.Visible = True
        .Parent.Activate

        'paste supplier name in word
        .content.Goto(what:=wdGoToBookmark, name:="SupplierName").PasteSpecial DataType:=wdPasteText
        Application.CutCopyMode = False '<-- it's always a good habit to set it after pasting has taken place

        'paste tables
        PasteTables .content, 2 '<-- call your specific Sub passing the referenced document content and "2" as the maximum number of tables to loop through

        'Save doc to a specific location and with a specific title
        name = "C:\Users\MyDesktop\Supplier\" & "DocName" & "_" & _
        sheets("Sheet1").Range("C1").Value & "_" & sheets("Sheet1").Range("H1").Value & _
        "_" & Format(Now, "yyyy-mm-dd") & ".docx"
        .ActiveDocument.SaveAs2 Filename:=name
    End With
End Sub