Delete rows if specific columns contain cells with "N/A"

[lekh0602]

Hi,

I would like to set up a button where cells with "N/A" in specific columns will then delete the relevant row - the columns are Z, AA and AB.

When I use the code below it does not seem to work.

The code is the following:

Sub Button3_Click()
'Declare variables
Dim rngFound As Range 'Used for the find loop
Dim rngDel As Range 'Used to store matching rows
Dim strFirst As String 'Used to store the first cell address of the find loop to prevent infinite loop


'Search for #N/A in column C
Set rngFound = Columns("Z").Find("#N/A", Cells(Rows.Count, "Z"), xlValues, xlWhole)


'Make sure something was found
If Not rngFound Is Nothing Then
'Found something, record first cell address
strFirst = rngFound.Address


'Start loop
Do
'Check if cells in column Z, AA, and AB are all #N/A
If Cells(rngFound.Row, "Z").Text = "#N/A" _
And Cells(rngFound.Row, "AA").Text = "#N/A" _
And Cells(rngFound.Row, "AB").Text = "#N/A" Then


'Found they are all #N/A, store the row in rngDel
If rngDel Is Nothing Then Set rngDel = rngFound Else Set rngDel = Union(rngDel, rngFound)


End If


'Advance the loop to the next cell with #N/A in column Z
Set rngFound = Columns("Z").Find("#N/A", rngFound, xlValues, xlWhole)


'Exit loop when back to the first cell
Loop While rngFound.Address <> strFirst
End If


'If rngDel has anything in it, delete all of its rows
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete


'Object variable cleanup
Set rngFound = Nothing
Set rngDel = Nothing


End Sub

I would appreciate any inputs to what I am doing wrong.

Thanks.

 

[vds1]

This would delete any error in column Z , AA , AB

Sub Button3_Click()
Dim Lrow As Long
Lrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Do While Lrow > 0
    If IsError(Cells(Lrow, 26)) Or IsError(Cells(Lrow, 27)) Or IsError(Cells(Lrow, 28)) Then
        Rows(Lrow).Delete
    End If
    Lrow = Lrow - 1
Loop
End Sub

 

[lekh0602]

Hi vds1,

Thank you very much for your help - the code works perfectly now

 

[vds1]

Hi vds1,

Thank you very much for your help - the code works perfectly now

Thank you for your feedback. Have a good day.

 

[lekh0602]

Hi vds1,

The spreadsheet I am working on is quite extensive with more than 30,000 rows from column A to AE and the code suddenly doesn't seem to work = the code starts running but then Excel stops responding so I need to restart Excel. Is there any way of optimising the code so Excel will work less hard and I can get the code to work in my spreadsheet?

Thanks.

 

[vds1]

Does it Crash if you try to sort ?

 

[lekh0602]

Yes, when I run the code Excel crashes... But the code works on a smaller sample of data!

 

[vds1]

*Bug in the code* I ll post it soon

 

[lekh0602]

Thanks a lot!

 

[vds1]

Try,

Sub Button3_Click()
Dim Lrow As Long
Dim i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Err_Desc
Lrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 2 To Lrow
    If IsError(Cells(i, 26)) Or IsError(Cells(i, 27)) Or IsError(Cells(i, 28)) Then
        Cells(i, 33) = 0
    Else
        Cells(i, 33) = 1
    End If
Next i
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "AG1:AG" & Lrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A1:AG" & Lrow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
For i = Lrow To 2 Step -1
    If Cells(i, 33) = 0 Then
        Rows(i).Clear
    Else
        Exit For
    End If
Next i
Range("AG1:AG" & Lrow).Clear
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
Err_Desc:
MsgBox Err.Description & " : " & Err.Number
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub