7
\$\begingroup\$

I'm fairly new to VBA and just completed my first script. It's completing the task I want it to do just fine, but it's really slow in doing so. It has to open and read about 1000 CSV files for each CSV filter for specific rows and copy those into tabs in a newly created document. It then has to save and close that new document and open the next CSV.

Are there parts in the script that are not "good-practice" in the sense that they severely slow down execution time?

It takes about 3 seconds per loop iteration, so 50 minutes for all 1,000 files. The machine has also crashed halfway through, although I'm not 100% sure that's because of the script.

Sub createLists()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim startDate As Date
    Dim endDate As Date
    Dim dateLooper As Date
    Dim currDate As String

    'Set date range for existing files
    startDate = #1/1/2012#
    endDate = #9/12/2014#

    'Array, which contains names for new worksheets as strings
    Dim tsN(1 To 12) As String
    tsN(1) = "AA11"
    tsN(2) = "AA22"
    tsN(3) = "AA33"
    tsN(4) = "AA44"
    tsN(5) = "AA55"
    tsN(6) = "AA66"
    tsN(7) = "BB11"
    tsN(8) = "BB22"
    tsN(9) = "BB33"
    tsN(10) = "BB44"
    tsN(11) = "BB55"
    tsN(12) = "BB66"

    Dim w1 As Workbook
    Dim w2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Dim localPath As String
    localPath = ThisWorkbook.path

    'Check for folder "Lists", create if non-existend
    Dim fso, folderN
    Set fso = CreateObject("Scripting.FileSystemObject")
    folderN = localPath & "\Lists\"
    If fso.FolderExists(folderN) = False Then MkDir folderN

    For dateLooper = startDate To endDate

        currDate = Format(dateLooper, "yyyy-mm-dd")

        'Open / create workbook objects
        Set w1 = Workbooks.Open(Filename:=localPath & "\roh\daten" & currDate & ".CSV", Local:=True)
        Set w2 = Workbooks.Add()

        'Array, which contains worksheet-objects which will reference new worksheets
        Dim ts(1 To 12) As Worksheet

        'Create new file and add/name new worksheets, set references to array ts
        For i = 1 To 12
            With w2.Sheets.Add()
                .Name = tsN(13 - i)
                .Activate
            End With
            If i = 1 Then w2.Worksheets(2).Delete
            Set ts(13 - i) = ActiveSheet
        Next i

        'Copy data:
        Set ws1 = w1.Sheets(1)

        'Iterate through products and copy corresponding data to seperate sheets in prev. created new file
        For i = 1 To 12
            Set ws2 = ts(i)

            'Filter data for product
            ws1.Range("A1:H1").AutoFilter Field:=2, Criteria1:="=" & tsN(i)
            ws1.Range("A1:H1").AutoFilter Field:=7, Criteria1:="=ja"

            'Select range and copy
            Dim lastRow As Long
            lastRow = ws1.UsedRange.Rows.Count
            ws1.Range("A1:H" & lastRow).Copy ws2.Range("A1:H1")

            'Sort copied data
            With ws2
                .Range("A1").Sort Key1:=.Range("D1"), Order1:=xlAscending, DataOption1:=xlSortNormal, Header:=xlYes
            End With

            ws1.AutoFilterMode = False
        Next i

        'Save newly created file
        w2.SaveAs Filename:=localPath & "\Lists\Lists-" & currDate & ".xls", FileFormat:=xlNormal
        w2.Close

        w1.Close

    Next dateLooper

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
\$\endgroup\$
4
  • \$\begingroup\$ SO-Side duplicate: stackoverflow.com/q/27379546/1803692 \$\endgroup\$
    – Vogel612
    Dec 9, 2014 at 13:23
  • \$\begingroup\$ Have you run the code successfully without the crash? If not, does it crash in the same place every time, or on different lines? \$\endgroup\$
    – Nick Udell
    Dec 9, 2014 at 13:26
  • \$\begingroup\$ I actually changed the "startDate" variable after the crash, so that it continued on from the date where it crashed. That worked fine, files are being created, it's still running though. \$\endgroup\$
    – bthorn
    Dec 9, 2014 at 13:30
  • \$\begingroup\$ I should add: it is running on a Core2 Duo 2.4 ghz, 4 gb ram. Are the 3 sec per loop indeed slow or do I just subjectively feel so? \$\endgroup\$
    – bthorn
    Dec 9, 2014 at 13:33

1 Answer 1

6
\$\begingroup\$

First of all use early binding over late binding to slightly improve the performance of code and to take advantage of intelli-sense.

In VBE select Tools and then References. Scroll down to Microsoft Scripting Runtime and tick the checkbox to attach references to your project. That allows you to change

Dim fso, folderN
Set fso = CreateObject("Scripting.FileSystemObject")

to

Dim fso As FileSystemObject, folderN As String
Set fso = New FileSystemObject

Generally, you want to explicitly dim your variables and avoid using Variant type as it slows down the code by a lot believe or not! Bascially, don't rely on the runtime to workout the correct type for a variable as it takes its time to do so.

There is an .Activate in the loop that creates the worksheets. It's redundant there and just adds overhead -> remove it/comment it out and modify the assignment based on the ActiveSheet to

'Create new file and add/name new worksheets, set references to array ts 
For i = 1 To 12
    With w2.Sheets.Add()
        .Name = tsN(13 - i)
    End With
    If i = 1 Then w2.Worksheets(2).Delete
    Set ts(13 - i) = w2.Sheets(tsN(13 - i))
Next i

The rest seems fine to me due to your current approach for reading the data. Your code seems rather clean, well indented and you have good comments in the right places.

Performance tip:

If performance is crucial to you consider another solution involving for example ADODB library and not opening the .CSV files just to get data out of them. ADODB allows you read the contents of a file into a Recordset object without actually opening the file (think of speed!). Then, you can use a very simple method of the Range class to copy the contents into the spreadsheet - Range.CopyFromRecordset.

You can see examples of how to use ADODB on my blog at http://vba4all.com - ADODB section is at the bottom of the article

\$\endgroup\$
8
  • 2
    \$\begingroup\$ Thanks! It shaved off about half a second per loop! There was just a small error in your code: Set ts(13 - i) = w2.Sheets(13 - i) needs to be Set ts(13 - i) = w2.Sheets(tsN(13 - i)). \$\endgroup\$
    – bthorn
    Dec 9, 2014 at 13:57
  • \$\begingroup\$ @Precog1 of course! well spotted \$\endgroup\$
    – user28366
    Dec 9, 2014 at 13:59
  • 2
    \$\begingroup\$ @Precog1 I highly recommend the ADODB approach for reading data from such a large number of files. Without a doubt opening each of those files will take an eternity in comparison. \$\endgroup\$
    – RubberDuck
    Dec 9, 2014 at 14:00
  • \$\begingroup\$ I'll take a look at that when I have a little breathing room, time wise ;) One last, quick question: when I assign the date the way I do, i.e. endDate = #9/12/2014# - which format does VBA assume that is? I mean it to be 9th of December 2014. \$\endgroup\$
    – bthorn
    Dec 9, 2014 at 14:06
  • \$\begingroup\$ @Precog1 VBA will think it's 12th of September 2014 most likely but if you say #13/12/2014# it will make it 13th of December 2014. If you want a consistent result for 9th of December 2014 try CDate(Format("09/12/2014", "dd/mm/yyyy")) \$\endgroup\$
    – user28366
    Dec 9, 2014 at 14:35

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.