Efficient VBA code for conditionally deleting rows in big excel sheet

[akash27]

My excel sheet has 40 columns and more than 1,00,000 rows. I want to delete all the rows which contain cell with a string "NA" in any of the columns. I am struggling to find an efficient VB code for this, which doesn't cause excel to crash. My current VBA code (explained below) takes forever to run (>5 mins on Intel Xenon and 16 GB RAM) and crashes on slower machines (i5, 4 GB RAM). Any suggestions to streamline and make it faster?
P.S. Exact number of rows and columns are not known apriori. And, I'm new to VBA, any help would be greatly appreciated.

My VBA code:

Sub DeleteRowWithContents()

'Finds the last non-blank cell on a sheet/range.

Dim lRow As Long
Dim lCol As Long

lRow= Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

lCol= Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column

        'MsgBox "Last Row: " & lRow
        'MsgBox "Last Column: " & lCol


     For j = lCol To 1 Step-1
     For i = lRow To 1 Step-1
        If(Cells(i, j).Value)="NA"Then
Cells(i,"A").EntireRow.Delete
        EndIf
    Next i
lRow= Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
    Next j


End Sub

[SamT]

Try this

Option Explicit

Sub DeleteRowWithContents()


Dim lRow As Long
Dim lCol As Long
Dim NA As Range

With UsedRange

'Finds the last non-blank cell on a sheet/range.
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

lCol = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column


Set NA = .Find(What:="NA", _
After:=Cells(lRow, lCol), _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
'Edit LookAt:= to suit

Do While Not NA Is Nothing
NA.EntireRow.Delete
Set NA = .FindNext("NA")
Loop
End With

End Sub

[akash27]

shows run-time error '1004' : Application-defined or object-defined error

Try this

Option Explicit

Sub DeleteRowWithContents()


Dim lRow As Long
Dim lCol As Long
Dim NA As Range

With UsedRange

'Finds the last non-blank cell on a sheet/range.
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

lCol = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column


Set NA = .Find(What:="NA", _
After:=Cells(lRow, lCol), _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
'Edit LookAt:= to suit

Do While Not NA Is Nothing
NA.EntireRow.Delete
Set NA = .FindNext("NA")
Loop
End With

End Sub

[SamT]

Did the error occur at the "Try this" line or at the "Option Explicit" line?

[mdmackillop]

Hi Sam
Changes to UsedRange and Find procedure

Option Explicit
 
Sub DeleteRowWithContents()
     
     
    Dim lRow As Long
    Dim lCol As Long
    Dim NA As Range
     
    With ActiveSheet.UsedRange
         
         'Finds the last non-blank cell on a sheet/range.
        lRow = Cells.Find(What:="*", _
        After:=Range("A1"), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
         
        lCol = Cells.Find(What:="*", _
        After:=Range("A1"), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Column
         
         
        Set NA = .Find(What:="NA", _
        After:=Cells(lRow, lCol), _
        LookAt:=xlWhole, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False)
         'Edit LookAt:= to suit
         
        Do While Not NA Is Nothing
            NA.EntireRow.Delete
            Set NA = .Find("NA")
        Loop
    End With
     
End Sub

[mdmackillop]

Two further options. Option 2 needs a helper column; AS in this example.

Option Explicit


Sub DeleteRowWithContents1()
    Dim lRow As Long
    Dim lCol As Long
    Dim NA As Range, Rng As Range
    Dim dic As Object, d, arr
    Dim FA As String
    Dim i
    
    Set dic = CreateObject("Scripting.dictionary")
    With Cells
        Set NA = .Find(What:="NA", _
        After:=Cells(1, 1), _
        LookAt:=xlWhole, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
        FA = NA.Address
        Do
            If Not dic.exists(NA.Row) Then dic.Add NA.Row, vbNull
            Set NA = .FindNext(NA)
        Loop Until NA.Address = FA
    End With
    
    arr = Application.Transpose(dic.keys)
    Set Rng = Rows(arr(1, 1))
    For i = 2 To UBound(arr)
    Set Rng = Union(Rng, Rows(arr(i, 1)))
    Next i
    
    Rng.Delete
    Cells(1, 1).Select


End Sub




Sub DeleteRowWithContents2()
    Dim LR


    LR = Cells(Rows.Count, 1).End(xlUp).Row
    Range(Cells(1, 45), Cells(LR, 45)).Formula = "=COUNTIF(RC1:RC[-1],""NA"")"
    Range("AS1").EntireRow.Insert
    Columns("AS:AS").AutoFilter Field:=1, Criteria1:=">0"
    Columns("AS:AS").SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Columns("AS:AS").ClearContents
    Cells(1, 1).Select
End Sub

[georgiboy]

Lots of replies now lol

Thought i would post what i had looked at

Sub SortDelete()

    With Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlCellTypeLastCell))
        .AutoFilter 2, "NA" 'Change the column number to suit location of "NA"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With
    
End Sub

Hope this helps

[SamT]

I wondered about that usage of UsedRange, but the Compiler didn't care.

I also wondered about .FindNext("NA") vs .FindNext(NA), but again, the compiler OKed it.

Does not .Find("NA") restart the search at the (old) last cell vs .FindNext start at the last found? or is it that since the last Found was deleted, it raises an error?

If that is the case, would it be more efficient to...

Set NA = .Find(blah,Blah).Offset(-1)

Do While Not NA Is Nothing 
            NA.offset(1).EntireRow.Delete 
            Set NA = .FindNext("NA").Offset(-1)
Loop

Presuming Row 1 is Headers and/or never contains "NA"





@ georgiboy,we all are assuming that "NA" can be in any column, otherwise yours would be the fastest.

[Paul_Hossler]

It's always been my assumption that it's the deleting rows that takes the most time since Excel has to 'repack' (?) pointers, etc.

I've never done any rigorous testing, so it'd be interesting to see how the different ideas score using lot of data

This doesn't delete them as it finds them, but at the end

Option Explicit
 
Sub DeleteRowWithNA()
    Dim lRow As Long
    Dim lCol As Long
    Dim NA As Range, DEL As Range
     
    With ActiveSheet.UsedRange
         
         'Finds the last non-blank cell on a sheet/range.
        lRow = Cells.Find(What:="*", _
            After:=Range("A1"), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row
         
        lCol = Cells.Find(What:="*", _
            After:=Range("A1"), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Column
         
         
        Set NA = .Find(What:="NA", _
            After:=Cells(lRow, lCol), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False)
         
        Do While Not NA Is Nothing
            NA.Clear
            If DEL Is Nothing Then
                Set DEL = NA.EntireRow
            Else
                Set DEL = Union(DEL, NA.EntireRow)
            End If
            Set NA = .Find("NA")
        Loop
    End With
     
    DEL.Delete
End Sub

[SamT]

Hmmm.That also seems to eliminate the possible error raising of Deleting NA before FindNext