Delete Empty/Blank Rows In Tables
Empty
Option Explicit
Sub deleteEmptyRowsInTables()
Dim wsIds As Variant
wsIds = Array("Sheet1", "Sheet2") ' add more, modify
Dim tblIds As Variant
tblIds = Array(1, 2) ' add more, modify
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
Dim ws As Worksheet ' Current Worksheet
Dim tbl As ListObject ' Current Table
Dim tRng As Range ' Current Total Range
Dim rRng As Range ' Current Row Range
Dim wsId As Variant ' Current Worksheet Id (Name or Index)
Dim tblId As Variant ' Current Table Id (Name or Index)
For Each wsId In wsIds
On Error Resume Next
Set ws = wb.Worksheets(wsId)
On Error GoTo 0
If Not ws Is Nothing Then
For Each tblId In tblIds
On Error Resume Next
Set tbl = ws.ListObjects(tblId)
On Error GoTo 0
If Not tbl Is Nothing Then
Set tRng = Nothing
For Each rRng In tbl.DataBodyRange.Rows
If Application.CountA(rRng) = 0 Then
If Not tRng Is Nothing Then
Set tRng = Union(tRng, rRng)
Else
Set tRng = rRng
End If
Else
' Current Row Range is not empty.
End If
Next rRng
If Not tRng Is Nothing Then
tRng.Delete
Else
' No empty rows found in Current Table.
End If
Else
' Table not found.
End If
Next tblId
Else
' Worksheet not found.
End If
Next wsId
End Sub
- With a few alterations, you can do it for blank cells i.e. empty cells and cells containing formulas evaluating to
"".
Blank
Sub deleteBlankRowsInTables()
Dim wsIds As Variant
wsIds = Array("Sheet1", "Sheet2") ' add more, modify
Dim tblIds As Variant
tblIds = Array(1, 2) ' add more, modify
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
Dim ws As Worksheet ' Current Worksheet
Dim tbl As ListObject ' Current Table
Dim tRng As Range ' Current Total Range
Dim rRng As Range ' Current Row Range
Dim wsId As Variant ' Current Worksheet Id (Name or Index)
Dim tblId As Variant ' Current Table Id (Name or Index)
Dim ColumnsCount As Long ' Current Row Range Columns Count
For Each wsId In wsIds
On Error Resume Next
Set ws = wb.Worksheets(wsId)
On Error GoTo 0
If Not ws Is Nothing Then
For Each tblId In tblIds
On Error Resume Next
Set tbl = ws.ListObjects(tblId)
On Error GoTo 0
If Not tbl Is Nothing Then
Set tRng = Nothing
ColumnsCount = tbl.DataBodyRange.Columns.Count
For Each rRng In tbl.DataBodyRange.Rows
If Application.CountBlank(rRng) = ColumnsCount Then
If Not tRng Is Nothing Then
Set tRng = Union(tRng, rRng)
Else
Set tRng = rRng
End If
Else
' Current Row Range is not blank.
End If
Next rRng
If Not tRng Is Nothing Then
tRng.Delete
Else
' No blank rows found in Current Table.
End If
Else
' Table not found.
End If
Next tblId
Else
' Worksheet not found.
End If
Next wsId
End Sub