Deleting all empty rows in a table using a macro

Article contributed by Dave Rado with acknowledgements to Ibby

See also What do I do with macros sent to me by other users to help me out?

Option Explicit

Public Sub DeleteEmptyRows()

Dim oTable As Table, oRow As Range, oCell As Cell, Counter As Long, _
NumRows As Long, TextInRow As Boolean

' Specify which table you want to work on.
Set oTable = Selection.Tables(1)
' Set a range variable to the first row's range
Set oRow = oTable.Rows(1).Range
NumRows = oTable.Rows.Count
Application.ScreenUpdating = False

For Counter = 1 To NumRows

    StatusBar = "Row " & Counter
    TextInRow = False

    For Each oCell In oRow.Rows(1).Cells
        If Len(oCell.Range.Text) > 2 Then
            'end of cell marker is actually 2 characters
            TextInRow = True
            Exit For
        End If
    Next oCell

    If TextInRow Then
        Set oRow = oRow.Next(wdRow)
    Else
        oRow.Rows(1).Delete
    End If

Next Counter

Application.ScreenUpdating = True

End Sub

Note that you could delete the empty rows from all tables in a document by replacing the line:

Set oTable = Selection.Tables(1)

With the line

For Each oTable In ActiveDocument.Tables

and adding the line:

Next oTable

just before:

Application.ScreenUpdating = True