1

I see several posts about deleting blank rows in a range and others about deleting table rows based on a single blank column, but nothing about deleting entirely blank table rows.

What's the quickest way to do this?

I posted my solution below to help others but I'm interested to see if anyone has a faster method.

Community
  • 1
  • 1
ChrisB
  • 3,024
  • 5
  • 35
  • 61

4 Answers4

3

Here's a procedure I use to delete blank table rows. I sometimes work with large (for Excel) data sets and this method is faster. It loads table rows into an array, checks the array for blank rows, and performs one range.delete operation at the end.

You use the procedure like this:

Sub Test()
    DeleteBlankTableRows ActiveSheet.ListObjects(1)
End Sub

ActiveSheet.ListObjects(1) is (usually) the first table table on the active worksheet.

Here's the actual procedure:

Sub DeleteBlankTableRows(ByVal tbl As ListObject)
    Dim rng As Range
    Set rng = tbl.DataBodyRange ' Get table data rows range.
    Dim DirArray As Variant
    DirArray = rng.Value2       ' Save table values to array.

    ' LOOP THROUGH ARRAY OF TABLE VALUES
    Dim rowTMP As Long
    Dim colTMP As Long
    Dim combinedTMP As String
    Dim rangeToDelete As Range

    '  Loop through rows.
    For rowTMP = LBound(DirArray) To UBound(DirArray)
        combinedTMP = vbNullString  ' Clear temp variable.

        ' Loop through each cell in the row and get all values combined.
        For colTMP = 1 To tbl.DataBodyRange.Columns.Count
            combinedTMP = combinedTMP & DirArray(rowTMP, colTMP)
        Next colTMP

        ' Check if row is blank.
        If combinedTMP = vbNullString Then
            ' Row is blank.  Add this blank row to the range-to-delete.
            If rangeToDelete Is Nothing Then
                Set rangeToDelete = tbl.ListRows(rowTMP).Range
            Else
                Set rangeToDelete = Union(rangeToDelete, tbl.ListRows(rowTMP).Range)
            End If
        End If
    Next rowTMP

    ' DELETE BLANK TABLE ROWS (if any)
    If Not rangeToDelete Is Nothing Then rangeToDelete.Delete
End Sub

This has some advantages over other methods:

  1. SPEED: In a test of a table with 200,000 rows and 8 columns, this method took 19 seconds. That's just over half the 34 seconds the SpecialCells(xlCellTypeBlanks) method needed for an identical table.
  2. IDENTIFIES FULLY BLANK TABLE ROWS: Unlike some other methods (like this one - although it is useful in some situations) this method looks for blanks in every cell of a row instead of just one.
ChrisB
  • 3,024
  • 5
  • 35
  • 61
2

This should work. Not sure if it's faster, but it's another way to do it:

Sub delete_blank_table_rows()
Dim Rng As Range, tempRng As Range
Set Rng = Range("Table1")    ' Change as necessary
Set Rng = Range(Cells(Rng.Rows(1).Row, Rng.Columns(1).Column), Cells(Rng.Rows(Rng.Rows.Count).Row, Rng.Columns(Rng.Columns.Count).Column))

Dim i       As Long
For i = Rng.Rows.Count To 1 Step -1
    Cells(Rng.Rows(i).Row, Rng.Columns(1).Column).Select
    Set tempRng = Range(Cells(Rng.Rows(i).Row, Rng.Columns(1).Column), Cells(Rng.Rows(i).Row, Rng.Columns(Rng.Columns.Count).Column))

    If WorksheetFunction.CountA(tempRng) = 0 Then
        tempRng.Delete shift:=xlUp
    End If

Next i
End Sub

Edit: And of course to speed it up you should turn off Screen Updating, Calculation while it runs.

BruceWayne
  • 22,923
  • 15
  • 65
  • 110
  • Thanks for posting this. I ran this first as is and it completed in 4 minutes 13 seconds. With screen updating and calculations set to manual it was cut down to 1 minute 17 seconds - faster but still far slower than the 19 seconds achieved with the method I posted as an answer....seems like there should be a faster way. – ChrisB Aug 02 '17 at 20:07
0

I think this may be faster (you can modify lastrow and lastcol to meet your table dimensions):

Sub delete_rows_blank2()

t = 1
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count

Do Until t = lastrow

For j = 1 To lastcol

    If Cells(t, j) = "" Then

        j = j + 1

            If j = lastcol Then
            Rows(t).Delete
            t = t + 1
            End If

    Else

        t = t + 1

    End If

Next

Loop

End Sub
0

Here is a code snippet that works for me. I have a table named "Metrics" that is on the worksheet linked to the metricsWKS variable. I use the table filter to select the rows to be deleted. In my case it is determined by blank values for both the client and job fields. The only tricky part is selecting the field. I still don't want to believe that the offset works only on the visible cells and skips the rows hidden by the filter.

If I had to check to see if a whole row was blank, I would add a table column calculating the length of the concatenation of the other columns and test for that. A purely VBA solution, which could be implied from the original question, could skip that step and check that the other field filters are blank as well.

I just checked it for a larger dataset, and it isn't very fast. Might be OK for a smaller dataset.

Dim metricsWKS As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlManual

' eliminate rows that have a blank client and a blank job
With metricsWKS.ListObjects("Metrics")
   .Range.AutoFilter Field:=.ListColumns("Client").Index, Criteria1:="=" ' client name is blank
   .Range.AutoFilter Field:=.ListColumns("Job Name").Index, Criteria1:="=" ' job name is blank
End With
Range("Metrics[[#Headers],[Task Name]]").Offset(1).Select ' select the first blank row under the header row
Range(Selection, Selection.End(xlDown)).Select ' add in all the other blank rows through the bottom of the filtered table
Selection.EntireRow.Delete ' delete all the rows
metricsWKS.ShowAllData ' clear the filter

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True