Find last Row... Delete Empty Rows

[buzz71023]

I have a spreadsheet with a ton of data exported from another database.
Column H is either blank or has a dollar amount (could be positive or negative). If column H is blank, I want to delete that entire row.
I've done some research and came up with the below but it doesn't seem to be performing the way I am needing it to.
It is deleting empty rows but it is sporadic I want to delete them all in one click.
Need some help in getting this to work and trying to understand why this code is only deleting a portion of the data each time I execute the macro.

Sub DeleteBlankVariances()
Dim rng As Range

lr = Cells(Rows.Count, 1).End(xlUp).Row

Set rng = Range("H2:H" & lr)

 For Each c In rng
        If c = "" Then c.EntireRow.Delete
    Next


End Sub

 

[kweaver]

Works for me. Is it possible some cells in H have a space that makes it appear the cell is empty?

 

[Peter_SSs]

trying to understand why this code is only deleting a portion of the data each time I execute the macro.

Almost certainly because you will have multiple consecutive blanks in column H. Suppose that rows 3 and 4 are blank in column H. Your code gets to row 3, deletes that row and moves to row 4. However, what was row 4 has moved up and is now row 3 and therefore misses its check for blank and hence is not deleted.
If deleting row-by-row you need to start from the bottom and work upwards.

However, you also said ..

I want to delete them all in one click.

There are several ways to achieve that but to advise an appropriate way for you, could your tell us

1. about how many rows of data you are likely to have altogether before any rows are deleted, and
2. about how many rows you expect to be blank in column H and need deleting.

 

[mohadin]

Hi
Unless"as kweaver Q"
Try this code and see if it suits you

Sub test()
ActiveSheet.Columns(8).SpecialCells(4).EntireRow.Delete
End Sub

 

[Peter_SSs]

Unless"as kweaver Q"

.. or unless there are 20,000 disjoint rows (or zero rows) to delete.

 

[vcoolio]

Hello Buzz,

If you don't mind sorting the data, using the Autofilter as follows will, in an instant, delete blank rows:

Sub TestDelete()

    Dim ws As Worksheet: Set ws = Sheets("Your sheet name here") '----> Add your sheet name.
    
    Application.ScreenUpdating = False
    
    ws.Range("A2", ws.Range("H" & ws.Rows.Count).End(xlUp)).Sort ws.[A2], 1
    
    With ws.Range("H1", ws.Range("H" & ws.Rows.Count).End(xlUp))
            .AutoFilter 1, ""
            .Offset(1).EntireRow.Delete
            .AutoFilter
    End With
    
    Application.ScreenUpdating = True

End Sub

This test code relates to Columns A - H. If there are more columns in your data set, then change 'H' to suit in the sort part of the code.

I hope that this helps.

Cheerio,
vcoolio.

 

[mohadin]

@ vcoolio
You might do away with the line

.Offset(1).EntireRow.Delete

By

 .AutoFilter 1, "<>"

 

[vcoolio]

Mohadin,

Absolutely not!

 

[mohadin]

Absolutely not! with no reason !!???

 

[Peter_SSs]

If you don't mind sorting the data, using the Autofilter as follows will, in an instant, delete blank rows:

It is not reliable. For example, with this sample data there should be the heading row and 2 other rows remaining but the code actually leaves the header row and 5 other rows!

buzz71023_1.xlsm
	A	B	C	D	E	F	G	H
1	Hdr1	Hdr2	Hdr3	Hdr4	Hdr5	Hdr6	Hdr7	Hdr8
2	1	1	3	6	1	2	2	9
3	3	1	6	9	5	7
4	1	4	9	3	9	9	5	1
5	6	1		1	5	5	2
6	5	9	3	6		9	1
7	4	1	1	1	1	1	1
Sheet2

As you alluded to, it may also alter the order of the remaining data.

For a very fast method that also retains the order of the remaining data and can accommodate any number of columns beyond column H ..

Sub Del_Rws()
'  Delete rows where col H is blank
  Dim a As Variant, b As Variant
  Dim lr As Long, nc As Long, i As Long, k As Long
  
  lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("H2:H" & lr).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If Len(a(i, 1)) = 0 Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub