Delete rows based on empty cell

[gingerbreadgrl]

Hi,

I know there are a few threads on this but I haven't found one that works. I have a column, column A, that contains headings in the rows. Column B will contain the appropriate data that corresponds to the heading. However, any data that does not apply will be blank in Column B. I would like to declare the sheet, as there are multiple in the workbook, and delete any rows, starting with row 1, where the cell in column B is blank. The sheet name is Record 1. Here is a sample of the data.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[/TR]
[TR]
[TD]Child 1[/TD]
[TD]Sue[/TD]
[/TR]
[TR]
[TD]Child 2[/TD]
[TD]Sam[/TD]
[/TR]
[TR]
[TD]Child 3[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

In this example, I would like row 3 to delete because the cell in column B is blank. I have tried using the following code, but neither option worked. Note, this code is placed within a larger macro so there is no end sub.

In this code, the author recommended that certain applications be disabled. No error is produced, but the rows do not delete.

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Dim deleteRow As Long
Dim ws As Worksheet
Set ws = Sheets("Record 1")
For deleteRow = ws.Range("B" & Rows.count).End(xlUp).Row To 1 Step -1
If ws.Range("B" & deleteRow).Value = "" Then
Rows(deleteRow).EntireRow.Delete
End If
Next deleteRow[/FONT]

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

Here is the second code I tried, this will select the first cell in column B that contains a value, but no rows are deleted. Note, the author chose to start the search at row b1000, which works for me.

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Dim xlastrow As Integer
Dim xrow As Integer
xrow = 1[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Sheets("Record 1").Range("b1000").End(xlUp).Select
xlastrow = ActiveCell.Row[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Do Until xrow = xlastrow[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
If Sheets("Record 1").Cells(xrow, 1).Value = "" Then
Sheets("Record 1").Cells(xrow, 1).Select
Selection.EntireRow.Delete[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]xrow = xrow - 1
xlastrow = xlastrow - 1

End If

xrow = xrow + 1[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Loop[/FONT]
<strike></strike>
[/FONT]
<strike></strike>

Any troubleshooting on either piece of code would be much appreciated!!

Best,
Gingerbreadgrl

 

[Akuini]

Try this:

Dim xRow As Long
Dim ws As Worksheet
Set ws = Sheets("Record 1")
xRow = ws.Range("A" & Rows.count).End(xlUp).Row
On Error Resume Next
ws.Range("B1:B" & xRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

 

[Akuini]

I edited & added "On Error Resume Next" 2 minutes after I replied for the first time.

 

[Rick Rothstein]

Try this:

Dim [B][COLOR="#FF0000"]xRow[/COLOR][/B] As Long
Dim ws As Worksheet
Set ws = Sheets("Record 1")
[B][COLOR="#FF0000"]xRow[/COLOR][/B] = ws.Range("A" & Rows.count).End(xlUp).Row
On Error Resume Next
ws.Range("B1:B" & [B][COLOR="#FF0000"]xRow[/COLOR][/B]).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0[/QUOTE]
I do not think you need calculate and/or specify the last row as SpecialCells will not look below the bottom of the UsedRange on the sheet it is examining for blank rows. I believe this should do the same thing that your code does and be just as efficient in doing it...
[CODE]On Error Resume Next
Sheets("Record 1").Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

 

[Akuini]

as SpecialCells will not look below the bottom of the UsedRange

Good point Rick. I never thought of that.
And when I check it using this code, it's true that it covers the usedrange only. Thanks.

Debug.Print Sheets("Record 1").Columns("B").SpecialCells(xlCellTypeBlanks).Address

 

[gingerbreadgrl]

Hi Rick and Akuini,

Akuini, oh my goodness, this worked like a charm! I'd been working on this for hours! May I ask what the "On Error Resume Next" and "On Error GoTo 0" part of the code (in red below) does? I have not seen that before...

Dim xRow As Long
Dim ws As Worksheet
Set ws = Sheets("Record 1")
xRow = ws.Range("A" & Rows.count).End(xlUp).Row
On Error Resume Next
ws.Range("B1:B" & xRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

Rick, I will try out your code now too!

Thanks so much!
Gingerbreadgrl
​

​

 

[gingerbreadgrl]

Hi Rick,

Your code worked as well! Thank you! I noticed you have the same lines as Akuini,

"On Error Resume Next" and "On Error GoTo 0," your code starts with it. What does that do?

Thanks!
Gingerbreadgrl
​

 

[Rick Rothstein]

I noticed you have the same lines as Akuini, "On Error Resume Next" and "On Error GoTo 0," your code starts with it. What does that do?

If you were to run the code when there were no blank cells for the SpecialCells function to find, it would raise an error... the On Error Resume Next stops VBA from raising that error and tell it to move on to the next code line... the On Error GoTo 0 tells VBA to stop looking for errors (even if there were no more code after it, using On Error GoTo 0 is still a good idea because it is possible for On Error Resume Next to remain "alive" even after the procedure it is in ends meaning it could possibly affect any code you ran after its procedure ended).

 

[gingerbreadgrl]

Hi Rick,

Thanks so much for taking the time to explain the functionality behind the line of code. It really helps me to understand how it works so that I can get better at this!

Best,
Gingerbreadgrl