Excel VBA loop runs well for small data sets, but takes exponentially longer with larger data sets

Question

I have created a macro in VBA that is supposed to check part numbers on an excel sheet vs the filenames of parts in a file directory. The script is this:

Sub scanDirectory()

    Dim path As String
    Dim currentPath As String
    Dim nameOfFile As String
    Dim counterA As Integer
    Dim success As Integer
    Dim endTester As String
    Dim draw As Integer
    'put the path to your folder here along with an \
    path = "\C:\Users\joe.blow\Documents\"

    counterA = 8
    Do Until counterA > 4294
        nameOfFile = Sheets("Sheet0").Cells(counterA, 2)

        currentPath = Dir(path)
        success = 0
        draw = 0
        Do Until currentPath = vbNullString
            Debug.Print currentPath

            'Success for Model
            endTester = nameOfFile + ".SLDPRT"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 5) = "Y"
                success = 1
            End If
            endTester = nameOfFile + ".sldprt"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 5) = "Y"
                success = 1
            End If

            'Success for Assembly
            endTester = nameOfFile + ".SLDASM"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 5) = "Y"
                success = 1
            End If

            'Succees for Drawing
            endTester = nameOfFile + ".SLDDRW"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 6) = "Y"
                draw = 1
            End If
            endTester = nameOfFile + ".slddrw"
            If currentPath = endTester Then
                Sheets("Sheet0").Cells(counterA, 6) = "Y"
                draw = 1
            End If

            If draw = 0 Then
                Sheets("Sheet0").Cells(counterA, 6) = "N"
            End If

            If success = 0 Then
                Sheets("Sheet0").Cells(counterA, 5) = "N"
            End If

            currentPath = Dir()
        Loop
    counterA = counterA + 1
    Loop  'NextLine' End Sub

It works by going line by line and checking each cell vs the entire file tree, checking every permutation of filename extension. It then puts in an empty column if the file is there or not with a corresponding 'Y' or 'N'. It does this with both Models AND Drawings at the same time.

It works great for data sets <100 but my lists are sometimes 9000+ items long. When I run this on those longer sheets, it will run fine for ~5 seconds, then become unresponsive and (Not Responding). If I then wait for a long time >1hr, then it will finish running even though it was "Not Responding". Is there any better way to run this so that it will not take as long or

One tip is to add `Application.ScreenUpdating = False` at the beginning of your code and then `Application.ScreenUpdating = True` at the end. See [here for some more pointers on speeding up your code](https://stackoverflow.com/questions/47089741/how-to-speed-up-vba-code?utm_medium=organic&utm_source=google_rich_qa&utm_campaign=google_rich_qa) — Samuel Everson, May 30 '18 at 14:24
Possible duplicate of [How To Speed Up VBA Code](https://stackoverflow.com/questions/47089741/how-to-speed-up-vba-code) — Samuel Everson, May 30 '18 at 14:26
you can definitely clean the code to be more efficient. you have many superfluous if statements. I will post an answer in a few moments. — Scott Holtzman, May 30 '18 at 14:26
Why not import all the filenames into a sheet and then sort the data from there, it will be much quicker then doing it on the fly: https://stackoverflow.com/a/44068091/5202456 (this code even calculates the time it took to import the data) — 5202456, May 30 '18 at 14:29

Scott Holtzman · Accepted Answer · 2018-05-31T12:19:45.257

0

By using the built in FileSystemObject you can check if a file exists in a given path directly, so no need to loop through the file list for each cell.

Give this a whirl and see if it helps, significantly shortened code, improved readability and made the processor work less :)

Option Explicit

Sub scanDirectory()

    Application.ScreenUpdating = False

    Dim path As String
    'put the path to your folder here along with an \
    path = "\C:\Users\joe.blow\Documents\"

    Dim counterA As Integer
    counterA = 8

    Do Until counterA > 4294

        'grab file name from cell
        Dim nameOfFile As String
        nameOfFile = Sheets("Sheet0").Cells(counterA, 2)

        Dim fso As New FileSystemObject 'be sure to check Microsoft Scripting Runtime in Tools > References

        'check for Drawing
        Sheets("Sheet0").Cells(counterA, 6).Value = IIf(fso.FileExists(path + nameOfFile + ".SLDDRW"), "Y", "N")

        'check for Model or Assembly
        Dim maCheck As Boolean
        If fso.FileExists(path + nameOfFile + ".SLDPRT") Or fso.FileExists(path + nameOfFile + ".SLDASM") Then maCheck = True

        Sheets("Sheet0").Cells(counterA, 5).Value = IIf(maCheck, "Y", "N")
        maCheck = False

        counterA = counterA + 1

    Loop  'NextLine

End Sub

edited May 31 '18 at 12:19

answered May 30 '18 at 14:52

Scott Holtzman

27,099
5
37
72

It seems to not be able to find any files, neither the Model files nor the Drawing files. How does it check the files against each other? How does it accommodate for the different file extensions? – Astarngo May 30 '18 at 15:23
[tempsnip.png](https://postimg.cc/image/utdirxsi5/) The two right most columns are the output I am getting from the new script – Astarngo May 30 '18 at 15:32
I think the problem is that I do not have the file extensions of the part numbers on the Excel file – Astarngo May 30 '18 at 18:31
Thanks a bunch for your help so far! The drawing part of the updated code seems to work, but the Model column shows up as all 'Y' now – Astarngo May 30 '18 at 19:02
@Astarngo - Fixed that. I forgot to set `maCheck` back to false after using the condition for each test. (Reason all were yes was because first file was found, variable was set to true and never reset back to false for future tests, so it stayed true). – Scott Holtzman May 31 '18 at 12:20
Right, I had figured that out too. Thanks for the help! – Astarngo Jun 01 '18 at 12:47

Excel VBA loop runs well for small data sets, but takes exponentially longer with larger data sets

1 Answers1