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