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