My code is sooo slow..need to run 75 million loops

[yomero]

Hi Everyone,

I wrote the following code in order to match 5000 id numbers in LIST A , to 15000 id numbers in LIST B. This means 15000*5000=75 million loops. There are multiple items in LIST B that will match the ones in LIST A.
I had to add the workbook.save because it was freezing excel at item 6...I wonder what is bloating the cache so quickly.

My code is veeeery slow...any recommendations? maybe using arrays will be better? Thank you

Sub MatchFilename()

Dim cell, cell2 As Range
Dim r As Integer

Application.ScreenUpdating = False
r = 0

For Each cell In Sheets("HDFileList").Range("d4:d14897")
    For Each cell2 In Sheets("List").Range("al4:al4984")
            Application.StatusBar = cell.Row & " item of 14897 " & "Matched: " & r
        
        'cell.Select
        'If cell = "" Then GoTo Jump2
        If cell = cell2 Then
            r = r + 1
            Sheets("HDFileList").Range("G1") = r
            'MsgBox "MATCH"
            
           With cell.Offset(0, 3)
                .Formula = "Yes" 'Matched
                .Interior.Color = vbYellow
            End With
            
            cell.Offset(0, 4) = cell2.Offset(0, 1) 'Cat
            cell.Offset(0, 5) = cell2.Offset(0, 2) 'Sub
            
        Else
        End If
    Next cell2

ActiveWorkbook.Save
Next cell

MsgBox "Finished"

End Sub

 

[SaraT]

why have the activeworkbook save every time?

You should consider having the workbook save after every like 100 loops.

Sub MatchFilename()

Dim cell, cell2 As Range
Dim r As Integer
Dim x As Integer

Application.ScreenUpdating = False
r = 0

For Each cell In Sheets("HDFileList").Range("d4:d14897")
    For Each cell2 In Sheets("List").Range("al4:al4984")
            Application.StatusBar = cell.Row & " item of 14897 " & "Matched: " & r
        
        'cell.Select
        'If cell = "" Then GoTo Jump2
        If cell = cell2 Then
            r = r + 1
            Sheets("HDFileList").Range("G1") = r
            'MsgBox "MATCH"
            
           With cell.Offset(0, 3)
                .Formula = "Yes" 'Matched
                .Interior.Color = vbYellow
            End With
            
            cell.Offset(0, 4) = cell2.Offset(0, 1) 'Cat
            cell.Offset(0, 5) = cell2.Offset(0, 2) 'Sub
            
        Else
        End If
    Next cell2
x = x + 1

if right(x,2) = "00" then
ActiveWorkbook.Save
end if

Next cell
ActiveWorkbook.Save
MsgBox "Finished"

End Sub

you know what I mean?

 

[yomero]

why have the activeworkbook save every time?

You should consider having the workbook save after every like 100 loops.

x = x + 1

if right(x,2) = "00" then
ActiveWorkbook.Save
end if

you know what I mean?

I tried that, I set it up to run only 100, then 50, then 20, then 10...that's how i figured out it freezes after the 6 loop...weird eh ?

 

[AMAS]

A few suggestions that might (or might not) help:

Dim cell, cell2 As Range

should be

Dim cell As Range, cell2 As Range

THe way you have it now is saying the cell = variant.

 Application.StatusBar = cell.Row & " item of 14897 " & "Matched: " & r

is also probably slowing down your macro. Try commenting this out and re-running.

Change

.Formula = "Yes"

to

.Value= "Yes"

since this is not a formula but a value.

And here is something I have picked up along the way that I use for almost all code I write to speed up my macros:

    ' Turn off some Excel functionality so your code runs faster
        screenUpdateState = Application.ScreenUpdating
        statusBarState = Application.DisplayStatusBar
        calcState = Application.Calculation
        eventsState = Application.EnableEvents
    
        With Application
            .ScreenUpdating = False
            .DisplayStatusBar = False
            .Calculation = xlCalculationManual
            .EnableEvents = False
        End With

 
 
' Your code here
 
 
 
 
    ' Turn Excel functionality back on
        With Application
            .DisplayStatusBar = statusBarState
            .Calculation = calcState
            .EnableEvents = eventsState
            .ScreenUpdating = screenUpdateState
        End With

Hope this helps.

AMAS

 

[yomero]

Thanks AMAS I will try it.

 

[brettdj]

This looks like a straigtforward non-VBA job, ie
COUNTIF
Conditional Formatting
IF tests

If you did want to use VBA then coding with formulae not loops will be much quicker. If loops on ranges are necessary for a task then variant arrays are much prereferable

Cheers

Dave

 

[Peter_SSs]

I agree with Dave that this could be done pretty easily with formulas and Conditional Formatting. However, if you are needing vba for some reason, you could try this in a copy of your workbook.

You may find that you do not need the Status Bar update but if you do, just uncomment the various code lines related to that. It would then just update the status bar every 100 matches found.

Depending on what version of Excel you are using and how many "Yes" values are produced and their arrangement in the column, there may also be an issue with the 'SpecialCells' line near the bottom of my code. Post back with details if that becomes an issue for you.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> MatchFN()<br>    <SPAN style="color:#00007F">Dim</SPAN> FL, L, R<br>    <SPAN style="color:#00007F">Dim</SPAN> UL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, UFL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> bFound <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> rFL <SPAN style="color:#00007F">As</SPAN> Range, rL <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    <SPAN style="color:#00007F">Set</SPAN> rFL = Sheets("HDFileList").Range("D4:D14897")<br>    <SPAN style="color:#00007F">Set</SPAN> rL = Sheets("List").Range("AL4:AN4984") <SPAN style="color:#007F00">'<- Note 3 columns</SPAN><br>    FL = rFL.Value<br>    L = rL.Value<br>    UFL = <SPAN style="color:#00007F">UBound</SPAN>(FL, 1)<br>    UL = <SPAN style="color:#00007F">UBound</SPAN>(L, 1)<br>    <SPAN style="color:#00007F">ReDim</SPAN> R(1 <SPAN style="color:#00007F">To</SPAN> UFL, 1 <SPAN style="color:#00007F">To</SPAN> 3)<br>    <br>    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> UFL<br>        <SPAN style="color:#00007F">If</SPAN> Len(FL(i, 1)) > 0 <SPAN style="color:#00007F">Then</SPAN><br>            j = 1<br>            bFound = <SPAN style="color:#00007F">False</SPAN><br>            <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">Until</SPAN> bFound <SPAN style="color:#00007F">Or</SPAN> (j = UL + 1)<br>                <SPAN style="color:#00007F">If</SPAN> L(j, 1) = FL(i, 1) <SPAN style="color:#00007F">Then</SPAN><br>                    bFound = <SPAN style="color:#00007F">True</SPAN><br>                    x = x + 1<br><SPAN style="color:#007F00">'                    If x Mod 100 = 0 Then</SPAN><br><SPAN style="color:#007F00">'                        Application.StatusBar = _<br>'                            i & " item of 14897 " _<br>'                            & "Matched: " & x</SPAN><br><SPAN style="color:#007F00">'                    End If</SPAN><br>                    R(i, 1) = "Yes"<br>                    R(i, 2) = L(j, 2)<br>                    R(i, 3) = L(j, 3)<br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>                j = j + 1<br>            <SPAN style="color:#00007F">Loop</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> i<br>    <br>    Sheets("HDFileList").Range("G1").Value = x<br>    rFL.Offset(, 3).Resize(, <SPAN style="color:#00007F">UBound</SPAN>(R, 2)).Value = R<br>    <SPAN style="color:#00007F">If</SPAN> x > 0 <SPAN style="color:#00007F">Then</SPAN><br>        rFL.Offset(, 3).SpecialCells(xlCellTypeConstants) _<br>            .Interior.Color = vbYellow<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#007F00">'    Application.StatusBar = False</SPAN><br>    MsgBox "Finished"<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[AlphaFrog]

Here's my go at it. Should take about a second or so to complete.

Sub Match_File2()

    Dim D, AL
    Dim Dict As Object, G()
    Dim r&, x&, y&
    
    AL = Sheets("List").Range("AL4:AN4984")
    Set Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = 1
    For r = 1 To UBound(AL, 1)
        Dict(AL(r, 1)) = r
    Next r
    
    D = Sheets("HDFileList").Range("D4:D14897")
    ReDim G(1 To UBound(D, 1), 1 To 3)
    For r = 1 To UBound(D, 1)
        If Dict.Exists(D(r, 1)) Then
            x = Dict(D(r, 1))
            G(r, 1) = "Yes"
            G(r, 2) = AL(x, 2)
            G(r, 3) = AL(x, 3)
            y = y + 1
        End If
    Next r
       
    Application.ScreenUpdating = False
    Sheets("HDFileList").Range("G1").Value = y
    With Sheets("HDFileList").Range("D4:D14897").Offset(, 3)
        .Resize(, 3).Clear
        .Resize(, 3) = G
        .SpecialCells(xlCellTypeConstants).Interior.Color = vbYellow
    End With
    Application.ScreenUpdating = True
    
    MsgBox "Done."
    
End Sub

 

[Peter_SSs]

Here's my go at it. Should take about a second or so to complete.

Certainly faster than mine.

 

[dk]

Here's my go at it. Should take about a second or so to complete.

Sub Match_File2()

    Dim D, AL
    Dim Dict As Object, G()
...

 Application.ScreenUpdating = True
    
    MsgBox "Done."
    
End Sub

Nice code mate Good example of the efficiency of arrays and the Scripting runtime.