VBA Delete Blank Row From an Excel Table

[ManUBlueJay]

I have a table on Sheet 1 called Table1.

The Table is 9 Columns wide and very long

Is there a simple VBA code that looks at this table and if the the whole row is blank it deletes the whole row from that table.
It Cannot delete the entire row of the worksheet as there is another table on that sheet.
It is not a one time exercise so I am trying to automate it

 

[JEC]

Something like this

Sub JEC()
 With Sheets(1).ListObjects(1)
    For i = .ListRows.Count To 1 Step -1
      If Len(Trim(Join(Application.Transpose(Application.Transpose(.ListRows(i).Range))))) = 0 Then .ListRows(i).Delete
    Next
 End With
End Sub

 

[DanteAmor]

Try this:

Sub DeleteRowInTable()
  Dim lo As ListObject
  Dim r As Long
  Set lo = ActiveSheet.ListObjects("Table1")
  For r = lo.DataBodyRange.Rows.Count To 1 Step -1
    With lo.DataBodyRange.Rows(r)
      If WorksheetFunction.CountA(.Value) = 0 Then .Delete
    End With
  Next
End Sub

 

[JEC]

Didn't think of Counta, easier

Sub JEC()
 With Sheets(1).ListObjects(1)
    For i = .ListRows.Count To 1 Step -1
      If Application.CountA(.ListRows(i).Range) = 0 Then .ListRows(i).Delete
    Next
 End With
End Sub

 

[ManUBlueJay]

I just managed to get this to work, or is this a slow way.
It looks at the Col called Element which is always empty if the whole row is empty

Sub DeleteBlanks()

With Worksheets("Sheet1").ListObjects("Table1")
     .ListColumns("Element").DataBodyRange.SpecialCells(xlCellTypeBlanks).Rows.Delete
End With

End Sub

 

[ManUBlueJay]

JEC second option works perfect and is fast

 

[skf786]

Hello,

my problem is a bit similar. my table headers are in c30:k30 and i am using the attached code to paste some data in the table. what i am looking for is a code to add to it that would run after my data pasting code (code will be added to the existing macro) and then delete table rows having all blank cells.

thank you

KF

Sub Create_Entry()
'
' Create_Entry Macro
'
' Keyboard Shortcut: Ctrl+a
'

Application.ScreenUpdating = False


With ActiveSheet
      .Unprotect "7860"


Range("E10").Select
    Selection.Copy
    Range("A10").Select
    ActiveWindow.LargeScroll Down:=1
    Range("A37").Select
    ActiveWindow.LargeScroll Down:=1
    Range("A64").Select
    ActiveWindow.LargeScroll Down:=1
    Range("A91").Select
    Selection.End(xlDown).Select
    Range("A5001").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.ScrollRow = 4989
    ActiveWindow.ScrollRow = 4909
    ActiveWindow.ScrollRow = 3
    ActiveCell.Offset(-5001, 4).Range("A1").Select





    Range("D10:G10").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D31").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("D31").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E10").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("F10:G13").Select
    Selection.ClearContents
    
 

 

  Range("E10").Select



    .Protect "7860"

End With

    
    
End Sub