# Using Excel VBA to Find Empty Table Cells in Word Documents



## johnodocs (Dec 2, 2016)

Hi Guys

Let me first say I am not an advanced user with VBA but have always seemed to get along by trial and error but this week I have come undone and would be grateful for some help.

Here is the background. I have a spreadsheet with 1,500 rows that link to Parent Reports that out teachers' have done in Word Documents. Normally it is an administrators job to check all these and see if a teacher has left any cells blank in the tables within the document, meaning that it is incomplete - a horrible job but a necessary job.

I've been working with some code from here:Detect whether a table cell is empty

So far I have been able to get to the point when Excel opens the word document but it all unravels there. Also I get the error "The remote server machine does not exist or isn't available"

Any help would be greatly appreciated and of course let me know if you need more information


******

Sub ThemeBlankBox()

Dim Path As String
Dim objDoc As Word.Document
Dim objWord As Word.Application
Dim oCell As cell
Dim oRow As Row

    Sheets("Data").Select
    FinalRow = Range("A9999").End(xlUp).Row

    For I = 2 To FinalRow

    Path = Sheets("Data").Range("H" & I).Text


    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Open(Path)

   objWord.Visible = True

With objDoc
  For Each oRow In ActiveDocument.Tables(1).Rows ' this is where the error appears when running line by line (F8)
    For Each oCell In oRow.Cells
        If oCell.Range.Text = Chr(13) & Chr(7) Then
            Range("K" & I).Value = "Empty Cells Present"

            Else

            Range("K" & I).Value = "Complete"
        End If
    Next oCell
Next oRow

   End With

   Next I

    objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
    objWord.Quit

End Sub

****


----------



## Fennek (Dec 2, 2016)

Hi,

it is just a hint:

This code in word looks for empty cells:


```
Sub Read_Tab()
For i = 1 To ActiveDocument.Tables.Count
    For Each c In ActiveDocument.Tables(i).Range.Cells
        Tx = Left(c.Range.Text, Len(c.Range.Text) - 2)
        Debug.Print Tx
        If Tx = "" Then MsgBox "here"
    Next c
Next i
End Sub
```

regards


----------



## johnodocs (Dec 7, 2016)

Any more helpers out there? I'm still a bit stuck


----------



## NdNoviceHlp (Dec 7, 2016)

So if U find 1 blank cell in any table of a doc then U want it to notify U? Anyways, it's a blizzard outdoors and I'm bored. Trial this. Seems like it should work. Dave

```
Option Explicit
Sub ThemeBlankBox()
Dim DocPath As String, objDoc As Object, objWord As Object
Dim Row As Integer, Col As Integer, I As Integer
Dim FinalRow As Integer, DocNumber As Integer
'loops through documents paths in Sheet "Data" H2:H FinalRow
'loops through doc tables
'if blank table cell found inserts "Empty Cells Present" in "K"
'if no blank table cell found inserts "Complete" in "K"

FinalRow = Sheets("Data").Range("H9999").End(xlUp).Row
On Error GoTo FixIt
Set objWord = CreateObject("Word.Application")
'loop docs
For DocNumber = 2 To FinalRow
DocPath = Sheets("Data").Range("H" & DocNumber).Text
Set objDoc = objWord.Documents.Open(Filename:=DocPath)
With objDoc
'loop tables
For I = 1 To .Tables.Count
With .Tables(I)
For Row = 1 To .Rows.Count
For Col = 1 To .Columns.Count
If .cell(Row, Col).Range.Text = Chr(13) & Chr(7) Then
Sheets("Data").Range("K" & DocNumber).Value = "Empty Cells Present"
'exit doc
GoTo below
End If
Next Col
Next Row
End With
Sheets("Data").Range("K" & DocNumber).Value = "Complete"
below:
Next I
.Close SaveChanges:=False
End With
Next DocNumber
'tidy up
objWord.Quit
Set objDoc = Nothing
Set objWord = Nothing
Exit Sub
'error stuff
FixIt:
On Error GoTo 0
MsgBox "Error"
objWord.Quit
Set objDoc = Nothing
Set objWord = Nothing
End Sub
```
ps. Late binding is used. So no need to set a reference to the Word library.


----------



## NdNoviceHlp (Dec 7, 2016)

That wasn't quite right. The "below:" was in the wrong spot. This is better. Dave

```
Option Explicit
Sub ThemeBlankBox()
Dim DocPath As String, objDoc As Object, objWord As Object
Dim Row As Integer, Col As Integer, I As Integer
Dim FinalRow As Integer, DocNumber As Integer
'loops through documents paths in Sheet "Data" H2:H FinalRow
'loops through doc tables
'if blank table cell found inserts "Empty Cells Present" in "K"
'if no blank table cell found inserts "Complete" in "K"

FinalRow = Sheets("Data").Range("H9999").End(xlUp).Row
On Error GoTo FixIt
Set objWord = CreateObject("Word.Application")

'loop docs
For DocNumber = 2 To FinalRow
'DocPath = "D:\tabletest.doc"
DocPath = Sheets("Data").Range("H" & DocNumber).Text
Set objDoc = objWord.Documents.Open(Filename:=DocPath)
With objDoc
'loop tables
For I = 1 To .Tables.Count
With .Tables(I)
For Row = 1 To .Rows.Count
For Col = 1 To .Columns.Count
If .cell(Row, Col).Range.Text = Chr(13) & Chr(7) Then
Sheets("Data").Range("K" & DocNumber).Value = "Empty Cells Present"
'exit doc
GoTo below
End If
Next Col
Next Row
End With
Next I
Sheets("Data").Range("K" & DocNumber).Value = "Complete"
below:
.Close SaveChanges:=False
End With
Next DocNumber

'tidy up
objWord.Quit
Set objDoc = Nothing
Set objWord = Nothing
Exit Sub

'error stuff
FixIt:
On Error GoTo 0
MsgBox "Error"
objWord.Quit
Set objDoc = Nothing
Set objWord = Nothing
End Sub
```


----------



## johnodocs (Dec 8, 2016)

Hey,

Thanks for this. I'll try it and let you know.

John


----------



## johnodocs (Dec 13, 2016)

This worked a charm! I really appreciate your help!


----------



## NdNoviceHlp (Dec 13, 2016)

You are Welcome! Thanks for posting your outcome. Dave


----------



## johnodocs (Dec 16, 2016)

I spoke to soon 

After running it on the larger data set it gets passed 95 records and then I get an error "The requested member of the collection does not exist".

Seems it doesn't like the file it is working on.

Any ideas?


----------



## Macropod (Dec 16, 2016)

Try:

```
Sub ReportTableBlanks()
Application.ScreenUpdating = False
Dim objWord As Object, objDoc As Object
Dim r As Long, t As Long, c As Long
Dim xlSht As Worksheet, StrRpt As String
'loops through documents paths in "Data" Sheet, Column H
'if document not found inserts "File not found" in Column K
'loops through doc tables
'if blank table cell found inserts "Empty Cells Present" in Column K
'if no blank table cell found inserts "Complete" in Column K
Set xlSht = Sheets("Data")
Set objWord = CreateObject("Word.Application")

With objWord
  'loop docs
  For r = 2 To xlSht.Range("H9999").End(xlUp).Row
    If Dir(Sheets("Data").Range("H" & r).Text, vbNormal) = "" Then
      xlSht.Range("K" & r).Value = "File not found"
    Else
      Set objDoc = .Documents.Open(Sheets("Data").Range("H" & r).Text, False, True, False)
      With objDoc
        StrRpt = ""
        'loop tables
        For t = 1 To .Tables.Count
          With .Tables(t).Range
            For c = 1 To .Cells.Count
              If Len(.Cells(c).Range.Text) = 2 Then
                StrRpt = StrRpt & " " & t
                Exit For
              End If
            Next
          End With
        Next
        If StrRpt <> "" Then
          xlSht.Range("K" & r).Value = "Empty cell(s) found in table(s)" & StrRpt
        Else
          xlSht.Range("K" & r).Value = "Complete"
        End If
        .Close False
      End With
    End If
  Next
  .Quit
End With
Set objDoc = Nothing: Set objWord = Nothing: Set xlSht = Nothing
Application.ScreenUpdating = True
End Sub
```


----------



## johnodocs (Dec 2, 2016)

Hi Guys

Let me first say I am not an advanced user with VBA but have always seemed to get along by trial and error but this week I have come undone and would be grateful for some help.

Here is the background. I have a spreadsheet with 1,500 rows that link to Parent Reports that out teachers' have done in Word Documents. Normally it is an administrators job to check all these and see if a teacher has left any cells blank in the tables within the document, meaning that it is incomplete - a horrible job but a necessary job.

I've been working with some code from here:Detect whether a table cell is empty

So far I have been able to get to the point when Excel opens the word document but it all unravels there. Also I get the error "The remote server machine does not exist or isn't available"

Any help would be greatly appreciated and of course let me know if you need more information


******

Sub ThemeBlankBox()

Dim Path As String
Dim objDoc As Word.Document
Dim objWord As Word.Application
Dim oCell As cell
Dim oRow As Row

    Sheets("Data").Select
    FinalRow = Range("A9999").End(xlUp).Row

    For I = 2 To FinalRow

    Path = Sheets("Data").Range("H" & I).Text


    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Open(Path)

   objWord.Visible = True

With objDoc
  For Each oRow In ActiveDocument.Tables(1).Rows ' this is where the error appears when running line by line (F8)
    For Each oCell In oRow.Cells
        If oCell.Range.Text = Chr(13) & Chr(7) Then
            Range("K" & I).Value = "Empty Cells Present"

            Else

            Range("K" & I).Value = "Complete"
        End If
    Next oCell
Next oRow

   End With

   Next I

    objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
    objWord.Quit

End Sub

****


----------



## johnodocs (Dec 16, 2016)

thanks Paul for such a quick reply.

this did the job. Out of curiosity what was causing the error?


----------



## Macropod (Dec 16, 2016)

I didn't bother trying to find out what was causing the error(s) in the other code - I simply re-wrote it. As you can see, the structure I used is quite different.


----------

