Automatically Delete all blank rows in a Word table

Try pasting this code (in blue) into the VBA editor.

Then run the macro called EmptyRowDelete

=======================================

Public Sub EmptyRowDelete()

Dim myTable As Table, myRow As Range, myCell As Cell, Counter As Long, _
TextInRow As Boolean, NumRows As Long

Set myTable = Selection.Tables(1)
Set myRow = myTable.Rows(1).Range
NumRows = myTable.Rows.Count

For Counter = 1 To NumRows

StatusBar = “Row ” & Counter
TextInRow = False

   For Each myCell In myRow.Rows(1).Cells
If Len(myCell.Range.Text) > 2 Then
   TextInRow = True
   Exit For
End If
   Next myCell

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

End Sub

How can I delete all blank rows in a Word Table?