0

In my macro, I want to delete completely blank Rows. Not Rows that has something in one column because that is still valuable information.

I have looked all over the internet but if someone could come up with a function that deletes ENTIRELY blank rows and not just rows with something missing in a few columns that would be awesome.

(Information is only on Columns A through N and roughly 7 thousand rows). I haven't developed any code for this because I am really stumped.

Raj More
  • 47,048
  • 33
  • 131
  • 198
Jacob
  • 59
  • 6

2 Answers2

2

You can use this...

Sub ClearEmptyRows()
  Dim r As Long, lastrow As Long, WS As Worksheet, killRng As Range

Set WS = ActiveSheet

lastrow = WS.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Set killRng = WS.Rows(Rows.Count)

For r = 1 To lastrow
    If Application.WorksheetFunction.CountA(WS.Rows(r)) = 0 Then
        Set killRng = Union(killRng, WS.Rows(r))
    End If

Next r

killRng.Delete

End Sub

A couple comments on this code for newbies as it's a common routine to loop through rows and do something (delete, highlight, hide, etc.)

  • It's always best to interact with Worksheet as infrequently as possible. Thus we execute the Delete AFTER all of the rows have been identified.
  • You can't Union an empty range, so I set the killRng to initially be the entire last row (hopefully this is always blank), and then the macro can proceed with Union. One could get around this by including an if-statement, but this requires the macro check if range exists on each row.
pgSystemTester
  • 8,979
  • 2
  • 23
  • 49
0

If you just want to remove empty rows and are not concerned about formatting this is super fast.

Sub RemoveEmptyRows()
    Dim results As Variant, Target As Range
    Dim c As Long, r As Long, n As Long
    Set Target = Worksheets("Sheet1").UsedRange

    If Target.Count > 0 Then
        ReDim results(1 To Target.Rows.Count, 1 To Target.Columns.Count)
        For r = 1 To Target.Rows.Count
            If WorksheetFunction.CountA(Target.Rows(r)) > 0 Then
                For c = 1 To Target.Columns.Count
                    n = n + 1
                    results(n, c) = Target.Cells(r, c).Value
                Next
            End If
        Next
    End If
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Target.Value = results
    Application.ScreenUpdating = xlCalculationAutomatic
    Application.ScreenUpdating = False
End Sub
TinMan
  • 6,624
  • 2
  • 10
  • 20