Delete Entire Row if Certain Cell is Blank in Each Row

[coach_veto]

Hi guys,

I am compiling a long list of data in about 800 rows or so.

I want to run a macro that when clicked, will loop through the rows and delete any rows that do not have a value in, say for example, cell A1,b1,c1 etc... all the way down the line.
I'm unsure if I will need extra code to shift the cells up after deletion so there are no blank rows in between data.

I don't think this is too difficult but I'm unsure about the best way to go about it. Any help/code would be appreciated.

Thanks!

 

[coach_veto]

I'm thinking an IF statement will have to be involved in this. By the way, the value I'm looking for in each cell in order to delete the row would be if its blank (or empty).

 

[Fishboy]

Hi guys,

I am compiling a long list of data in about 800 rows or so.

I want to run a macro that when clicked, will loop through the rows and delete any rows that do not have a value in, say for example, cell A1,b1,c1 etc... all the way down the line.
I'm unsure if I will need extra code to shift the cells up after deletion so there are no blank rows in between data.

I don't think this is too difficult but I'm unsure about the best way to go about it. Any help/code would be appreciated.

Thanks!

Hi coach_veto,

Try out the following macro in a COPY of your workbook:

Sub DeleteRows()
' Defines variables
Dim x As Long, LastRow As Long, cRange As Range


' Defines LastRow as the last row of data based on column D
LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
' Sets the check range as D1 to the last row of D
Set cRange = Range("D1:D" & LastRow)


' For each cell in the check range, working from the bottom upwards
For x = cRange.Cells.Count To 1 Step -1
    With cRange.Cells(x)
        ' If column A, B and C of the current row are all empty then...
        If Application.WorksheetFunction.CountIf(Range("A" & .Row, "C" & .Row), "") = 3 Then
            ' Delete that row
            .EntireRow.Delete
        End If
    End With
' Check next cell in check range, moving from the bottom upwards
Next x

' Display optional message to confirm the task is finished
MsgBox "Complete"


End Sub

 

[coach_veto]

Hi Fishboy,

Thank you for the macro. Just a couple questions:

1) Any specific reason why you're choosing column D to count how many rows I have? (If I know I'm always going to have 804 rows does it make sense to change that part of the code?)
2) If I want the macro to just check the cells in column A of all the rows and not B or C, would I change that part of the code?

Thanks again!

 

[Fishboy]

Hi Fishboy,

Thank you for the macro.

You're welcome

Just a couple questions:

1) Any specific reason why you're choosing column D to count how many rows I have? (If I know I'm always going to have 804 rows does it make sense to change that part of the code?)

We test for the last row in case you don't already know exactly how many rows are in the data set. I have used column D to test the last row as I assumed (perhaps incorrectly) that if the actual last row has no values in A, B or C but has values in D, we would need to know to check as far down the data set as that.

2) If I want the macro to just check the cells in column A of all the rows and not B or C, would I change that part of the code?

For checking a single column rather than checking if A, B and C are ALL blank, you could simplify the code as follows, obviously changing the "A" reference to your desired column:

Sub DeleteRows()
' Defines variables
Dim x As Long, LastRow As Long, cRange As Range


' Defines LastRow as the last row of data based on column D
LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
' Sets the check range as D1 to the last row of D
Set cRange = Range("D1:D" & LastRow)


' For each cell in the check range, working from the bottom upwards
For x = cRange.Cells.Count To 1 Step -1
    With cRange.Cells(x)
        ' If column A of the current row is empty then...
        If Range("A" & .Row).Value = "" Then
            ' Delete that row
            .EntireRow.Delete
        End If
    End With
' Check next cell in check range, moving from the bottom upwards
Next x


' Display optional message to confirm the task is finished
MsgBox "Complete"


End Sub