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