Delete empty rows in tables across multiple worksheets

Question

I am trying to deleted empty rows in a table across 3 different worksheets ("AAA", "CCC" & "EEE")that has table1, table2 & table3. I guess I could recycle a piece of code that I got from this forum. But how should I Code the "delete empty columns" part?

Sub Clean_Table_Click()
    Dim TabList() As String
    Dim i As Integer        ' TbList index
    Dim Tbl As ListObject     ' loop object: Table
    
    TabList = Split("AAA,BBB,CCC,DDD,EEE", ",")
    For i = 0 To UBound(TabList)
        On Error Resume Next
        ' an error will occur if sheet or table doesn't exist
        Set Tbl = Worksheets(TabList(i)).ListObjects(1)
        If Err = 0 Then
            On Error GoTo 0                 ' stop on further errors
            
            
            'What should I code here?
            
            
            
        End If
    Next i
End Sub

Does this answer your question? [Remove empty cells in Excel](https://stackoverflow.com/questions/38994264/remove-empty-cells-in-excel) — braX, Nov 28 '20 at 08:06
https://stackoverflow.com/questions/44251875/delete-blank-rows — braX, Nov 28 '20 at 08:07

VBasic2008 · Accepted Answer · 2020-11-28T08:33:50.310

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

Delete empty rows in tables across multiple worksheets

1 Answers1

Delete Empty/Blank Rows In Tables