Try:
Code:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Tbl As Table, cel As Cell, r As Long, x As Long
Dim bDel As Boolean, CCtrl As ContentControl
With ActiveDocument
For Each Tbl In .Tables
For r = Tbl.Rows.Count To 1 Step -1
With Tbl.Rows(r)
If Len(.Range.Text) = .Cells.Count * 2 + 2 Then
.Delete
Else
bDel = True
For Each cel In .Cells
If Len(cel.Range.Text) > 2 Then
If .Range.ContentControls.Count = 0 Then
bDel = False: Exit For
Else
For Each CCtrl In .Range.ContentControls
If CCtrl.ShowingPlaceholderText = False Then
bDel = False: Exit For
End If
x = x + Len(CCtrl.Range.Text)
Next
If x + 2 <= Len(cel.Range.Text) Then
bDel = False: Exit For
End If
End If
End If
Next cel
If bDel = True Then Tbl.Rows(r).Delete
End If
End With
Next r
Next Tbl
End With
Set cel = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub