VBA Delete row if certain cell ifs blank

[ORoxo]

Hey, everyone,
I need your help once again.

I have lots of data and would need to delete rows if certain cells are blank (For instance, if column X, Z or Y in a row are blank, I want the macro to delete the whole row)

Typically I would try to do it myself but I have a deadline and time is running out. Do you think you could help me out?

Kind regards,

 

[Vbagreenhorn1]

this works?

Sub Oroxo()
For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Cells(i, 24) = "" Or Cells(i, 25) = "" Or Cells(i, 26) = "" Then Cells(i, 1).EntireRow.Delete xlShiftUp
Next
End Sub

 

[My Aswer Is This]

What column will have data in all rows?

 

[My Aswer Is This]

Assuming there will always be data in column "A"
Try this

Sub Test_New()
'Modified 3-4-18 6:40 AM EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = Lastrow To 1 Step -1
        If Cells(i, "x").Value = "" Or Cells(i, "Y").Value = "" Or Cells(i, "Z").Value = "" Then Rows(i).Delete
    Next
Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

I have lots of data ...

Depends just how much you mean by "lots", but this should process a large number of rows very quickly.

Sub Del_Rw_Blanks_XYZ()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, j As Long, k As Long, uba2 As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Intersect(ActiveSheet.UsedRange, Columns("X:Z")).Value
  uba2 = UBound(a, 2)
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 2 To UBound(a)
    For j = 1 To uba2
      If IsEmpty(a(i, j)) Then
        b(i, 1) = 1
        k = k + 1
        Exit For
      End If
    Next j
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A1").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
      .Offset(1).Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[hiker95]

Oroxo,

If I understand you correctly, then, here is another macro code that will run in the active worksheet.

Please test the following macro on a copy of your workbook/worksheet.

Sub Oroxo_V2()
' hiker95, 03/04/2018, ME1046020
Application.ScreenUpdating = False
Dim r As Long, lr As Long
With ActiveSheet
  lr = .Columns("X:Z").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  For r = lr To 2 Step -1
    If .Cells(r, "X") = vbEmpty Or .Cells(r, "Y") = vbEmpty Or .Cells(r, "Z") = vbEmpty Then
      .Rows(r).Delete
    End If
  Next r
End With
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Try this:

Sub Filter_Me()
'Modified 3-4-2018 7:25 AM EST
    With ActiveSheet.Range("X1:Z" & Cells(Rows.Count, "A").End(xlUp).Row)
        .AutoFilter 1, Criteria1:=""
        .Offset(1).SpecialCells(12).EntireRow.Delete
        .AutoFilter
        .AutoFilter 2, Criteria1:=""
        .Offset(1).SpecialCells(12).EntireRow.Delete
        .AutoFilter
        .AutoFilter 3, Criteria1:=""
        .Offset(1).SpecialCells(12).EntireRow.Delete
        .AutoFilter
    End With
End Sub

 

[Peter_SSs]

@ hiker95
Your determination of lr is problematic. For example, your code does not delete the last two rows of this data, even though they meet the criteria for deletion.

Book1
	W	X	Y	Z	AA
9995	1	6	7	4	4
9996	4	4	5	3	8
9997	5			3	7
9998	5	3	3		4
9999	3				2
10000	4				7
Del Rws (2)

@ ORoxo
For consideration if your data is large. Testing the codes suggested on 10,000 rows of data, about 3,000 of which require deletion:

Post # 2: 11.938 seconds
Post # 4: 7.109 secs
Post # 5: 0.078 secs
Post # 6: 6.719 secs
Post # 7: 4.641 secs

 

[My Aswer Is This]

@ hiker95
Your determination of lr is problematic. For example, your code does not delete the last two rows of this data, even though they meet the criteria for deletion.

	W	X	Y	Z	AA
9995	1	6	7	4	4
9996	4	4	5	3	8
9997	5			3	7
9998	5	3	3		4
9999	3				2
10000	4				7

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Del Rws (2)​

@ ORoxo
For consideration if your data is large. Testing the codes suggested on 10,000 rows of data, about 3,000 of which require deletion:

Post # 2: 11.938 seconds
Post # 4: 7.109 secs
Post # 5: 0.078 secs
Post # 6: 6.719 secs
Post # 7: 4.641 secs

Peter:
I hear people on this forum saying don't use loops they are too slow.
So I use filter but your saying your script which uses a loop is faster then a filter. Why is that?

 

[hiker95]

Oroxo,

Here is an updated macro code that will run in the active worksheet.

Please test the following macro on a copy of your workbook/worksheet.

Sub Oroxo_V3()
' hiker95, 03/04/2018, ME1046020
Application.ScreenUpdating = False
Dim r As Long, lr As Long
With ActiveSheet
  lr = .Columns("A:Z").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  For r = lr To 2 Step -1
    If .Cells(r, "X") = vbEmpty Or .Cells(r, "Y") = vbEmpty Or .Cells(r, "Z") = vbEmpty Then
      .Rows(r).Delete
    End If
  Next r
End With
Application.ScreenUpdating = True
End Sub