VBA For loop using Find is slow. Suggestions for speeding up requested.

Spamz · Mar 17, 2009

I'm using Excel 2003. My macro takes a 40,000 line (approx) CSV file, and among other things finds rows with 10 keywords in the row and deletes the entire row.

The problem I want to solve is that the find loop is very very slow. It takes about 1-2 seconds per row to search through all my keywords. 40,000/60/60 = 11 hours.

The find operation is slower with the more words I add, but even with just one or two words, it was kind of slow. I have found that the find/replace command is much quicker, but I can't delete entire rows with that method and that is what I must do.

My approach uses a for each loop to iterate through each row. From there, I use a loop to find each of my key words in that row. Keywords are stored in an array.

Help to speed up this process would be appreciated!

Gabe

ShaunD30 · Mar 17, 2009

I am not sure how to code it because I am new..but I just read some posts today about a macro for Autofiltering. That might work faster.

Shaun

Colin Legg · Mar 17, 2009

Hi,

It would be much faster to use the range object's find method.

Rich (BB code):

Sub Example1()
    Dim vList, lArrCounter As Long
    Dim rngFound As Range, rngToDelete As Range, sFirstAddress As String
    
    Application.ScreenUpdating = False
    
    'a list of our keywords
    vList = Array("Here", "There", "Everywhere")
    
    For lArrCounter = LBound(vList) To UBound(vList)
        With Sheet1.Cells
            Set rngFound = .Find( _
                                What:=vList(lArrCounter), _
                                After:=.Cells(1), _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)
            
            If Not rngFound Is Nothing Then
                sFirstAddress = rngFound.Address
                
                If rngToDelete Is Nothing Then
                    Set rngToDelete = rngFound
                Else
                    If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Union(rngToDelete, rngFound)
                    End If
                End If
                
                Set rngFound = .FindNext(After:=rngFound)
                
                Do Until rngFound.Address = sFirstAddress
                    If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Union(rngToDelete, rngFound)
                    End If
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
        End With
    Next lArrCounter
    
    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

    Application.ScreenUpdating = True
End Sub

ShaunD30 · Mar 17, 2009

http://www.mrexcel.com/forum/showthread.php?t=378135&page=2

Try this thread..like I said..not sure if that is what you are looking for but it may help to autofilter those 10 words 1 at a time and delete all as they are filtered..

Shaun

Colin Legg · Mar 17, 2009

ShaunD30 said:
http://www.mrexcel.com/forum/showthread.php?t=378135&page=2

Try this thread..like I said..not sure if that is what you are looking for but it may help to autofilter those 10 words 1 at a time and delete all as they are filtered..

Shaun

Using the autofilter works well when you're looking in one column and when the data is well structured. If you're searching an entire sheet for a word then the range object's find method is a more flexible choice.

ShaunD30 · Mar 17, 2009

Ha..Colin you posted the answer..and my wrong answer was pointing to your autofilter post.

Sorry but I just amused myself

Shaun

Spamz · Mar 17, 2009

Thanks for quick response Colin. I am using essentially that approach, but with 10 words, should I expect better performance than 1 line a second?
My desktop admittedly sucks but my personal laptop is quite a bit newer and the code doesn't run much faster. I wondered if the find property of the range method was inherently slow or something.

Colin Legg · Mar 17, 2009

Thanks for quick response Colin. I am using essentially that approach

Hi,

The approach you described in post #1 sounded quite different but yes, the outline I showed should be pretty quick (depending on how many keywords are found and the size of your workbook). The key is to build a union of the ranges you want to delete and then to delete them all together in one go at the end to minimise the number of times the calculation tree has to be rebuilt. I suspect, from your original outline, your code is not doing that. You can also toggle application.enableevents off/on etc....

Spamz · Mar 17, 2009

Ok I see what I missed on the first scan. I'll union the range and then delete at end.
Here's my code.

Code:

Sub DeleteKeywords()
Dim delrange As Range
Dim lastrow As Long
Dim i As Long
Dim j As Long
Dim words As Variant
Dim firstaddress As Range
Dim start As Date
Dim endt As Date
start = Now()
Application.ScreenUpdating = False
Application.EnableEvents = False
words = Array("Word1", "Word2")
'example words included. There are 10 of them.
lastrow = Cells(65536, 1).End(xlUp).Row
With ActiveSheet.Range("E1:E" & lastrow)
For j = 1 To lastrow
For i = 1 To UBound(words)
Set delrange = .Find(words(i), LookIn:=xlValues, MatchCase:=False)

If delrange Is Nothing Then
Else
delrange.EntireRow.delete
End If
Next i
Application.StatusBar = "Scanning row " & j & " of " & lastrow
Next j
End With
endt = Now()
MsgBox ("That took " & DateDiff("s", start, endt) & "seconds")
Application.StatusBar = False
Application.EnableEvents = True
End Sub

Colin Legg · Mar 18, 2009

Hi,

That's some good work you've done there.

What I'd suggest is that you use my code as a template. It's tried and tested and, so long as the worksheet isn't protected and you don't have anything exotic in the worksheet such as array range formulas or merged cells, it should run pretty well. I've incorporated your timer so all you need to do is change the list of keywords (I've highlighted in red).

If the words are only part of the cell's contents then change xlWhole to xlPart.

If you want it to run on a particular sheet rather than the ActiveSheet then change ActiveSheet to the other sheet's codename.

Hope that helps...

Rich (BB code):

Sub Example1()
    Dim vList, lArrCounter As Long
    Dim rngFound As Range, rngToDelete As Range, sFirstAddress As String
    Dim sMsg As String, sngStart As Single
 
    On Error GoTo ErrorHandler
 
    sngStart = Timer
 
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
 
    'a list of our keywords
    vList = Array("Word1", "Word2", "Word3", "Word4", "Word5", _
                  "Word6", "Word7", "Word8", "Word9", "Word10")
 
    For lArrCounter = LBound(vList) To UBound(vList)
        With ActiveSheet.Cells
            Set rngFound = .Find( _
                                What:=vList(lArrCounter), _
                                After:=.Cells(1), _
                                LookIn:=xlValues, _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)
 
            If Not rngFound Is Nothing Then
                sFirstAddress = rngFound.Address
 
                If rngToDelete Is Nothing Then
                    Set rngToDelete = rngFound
                Else
                    If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Union(rngToDelete, rngFound)
                    End If
                End If
 
                Set rngFound = .FindNext(After:=rngFound)
 
                Do Until rngFound.Address = sFirstAddress
                    If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Union(rngToDelete, rngFound)
                    End If
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
        End With
    Next lArrCounter
 
    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
 
ErrorExit:
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
 
    If LenB(sMsg) = 0 Then sMsg = "The routine took " & (Timer - sngStart) & " seconds"
    MsgBox sMsg
 
    Exit Sub
 
ErrorHandler:
    sMsg = "Error " & Err.Number & vbLf & Err.Description
    Resume ErrorExit
End Sub

VBA For loop using Find is slow. Suggestions for speeding up requested.

Spamz

New Member

Excel Facts

ShaunD30

Board Regular

Colin Legg

MrExcel MVP

ShaunD30

Board Regular

Colin Legg

MrExcel MVP

ShaunD30

Board Regular

Spamz

New Member

Colin Legg

MrExcel MVP

Spamz

New Member

Colin Legg

MrExcel MVP

Similar threads

Forum statistics

Share this page

VBA For loop using Find is slow. Suggestions for speeding up requested.

New Member

Excel Facts

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

New Member

MrExcel MVP

New Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock