Using Excel VBA to Find Empty Table Cells in Word Documents

johnodocs

New Member
Joined
Oct 31, 2015
Messages
23
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

****
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Fennek

Active Member
Joined
Nov 21, 2016
Messages
279
Hi,

it is just a hint:

This code in word looks for empty cells:

Code:
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
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,791
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
Code:
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.
 
Last edited:

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,791

ADVERTISEMENT

That wasn't quite right. The "below:" was in the wrong spot. This is better. Dave
Code:
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
 
Last edited:

johnodocs

New Member
Joined
Oct 31, 2015
Messages
23

ADVERTISEMENT

This worked a charm! I really appreciate your help!
 

johnodocs

New Member
Joined
Oct 31, 2015
Messages
23
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

Retired Moderator
Joined
Aug 27, 2007
Messages
3,566
Try:
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,133,531
Messages
5,659,360
Members
418,499
Latest member
mbcmel

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top