modify macro to make it run faster - excel

Question

Who can help with this macro?
It's merging csv files into one.
csv files can be more than 500 and its running slow.
By the way it's taiking all data in csv file (2 rows). it will work for me if macro can take just second row from file..
Any ideas?
Option Explicit
Sub ImportCSV65()
Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Change the path to the source folder accordingly
strSourcePath = Worksheets("Tarpinis").Range("AJ8").Value
If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
strFile = Dir(strSourcePath & "*.csv")
Sheets("+65").Select
Application.ScreenUpdating = False
Do While Len(strFile) > 0
Cnt = Cnt + 1
If Cnt = 1 Then
r = 1
Else
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Open strSourcePath & strFile For Input As #1
If Cnt > 1 Then
Line Input #1, strData
End If
Do Until EOF(1)
Line Input #1, strData
x = Split(strData, ",")
For c = 0 To UBound(x)
Cells(r, c + 1).Value = Trim(x(c))
Next c
r = r + 1
Loop
Close #1
Name strSourcePath & strFile As strSourcePath & strFile
strFile = Dir
Loop
Application.ScreenUpdating = True
If Cnt = 0 Then _
MsgBox "No CSV files were found...", vbExclamation
Application.ScreenUpdating = False
End Sub

Answer 1

How about the following, it will read the second line from each CSV file in the given folder and write that line in the Sheet +65:
Option Explicit
Sub ImportCSV65()
Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Dim counter As Long
Dim ws As Worksheet: Set ws = Sheets("+65")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
counter = 0
'Change the path to the source folder accordingly
strSourcePath = Worksheets("Tarpinis").Range("AJ8").Value
If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
strFile = Dir(strSourcePath & "*.csv")
Do While Len(strFile) > 0
Open strSourcePath & strFile For Input As #1
Do Until EOF(1)
Line Input #1, strData
r = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
counter = counter + 1
If counter = 2 Then 'counter to get only second line
x = Split(strData, ",")
For c = 0 To UBound(x)
ws.Cells(r, c + 1).Value = Trim(x(c))
Next c
r = r + 1
Exit Do
End If
Loop
Close #1
Name strSourcePath & strFile As strSourcePath & strFile
strFile = Dir
counter = 0 'reset counter before next file
Loop
Application.ScreenUpdating = True
End Sub

Answer 2

The only obvious place that I can see that could be done better is the loop that writes the trimmed values into the cells.
If you must trim each value, then you'll still need to loop through the array and Trim it:
For c = 0 To UBound(x)
x(c) = Trim(x(c))
Next c
But to write to the cells, you can speed things up by writing the array directly to the range:
Cells(r, 1).Resize(1, UBound(x) + 1).Value = x
You might also gain a little bit of time by qualifying the destination sheet, preferably as a With.
So the whole thing would look like this:
Sub ImportCSV65()
Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Change the path to the source folder accordingly
strSourcePath = Worksheets("Tarpinis").Range("AJ8").Value
If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
strFile = Dir(strSourcePath & "*.csv")
With Sheets("+65")
.Select
Application.ScreenUpdating = False
Do While Len(strFile) > 0
Cnt = Cnt + 1
If Cnt = 1 Then
r = 1
Else
r = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End If
Open strSourcePath & strFile For Input As #1
If Cnt > 1 Then
Line Input #1, strData
End If
Do Until EOF(1)
Line Input #1, strData
x = Split(strData, ",")
For c = 0 To UBound(x)
x(c) = Trim(x(c))
Next c
.Cells(r, 1).Resize(1, UBound(x) + 1).Value = x
r = r + 1
Loop
Close #1
Name strSourcePath & strFile As strSourcePath & strFile
strFile = Dir
Loop
End With
Application.ScreenUpdating = True
If Cnt = 0 Then _
MsgBox "No CSV files were found...", vbExclamation
Application.ScreenUpdating = False
End Sub

Answer 3

Workbooks.Open Filename:=strSourcePath & strFile, Format:=2
This code will open csv file as excel type.
And get data as variant vlaue and will fill your sheet by variant value.
Sub ImportCSV65()
Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim Ws As Worksheet, rngT As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Change the path to the source folder accordingly
strSourcePath = Worksheets("Tarpinis").Range("AJ8").Value
If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
strFile = Dir(strSourcePath & "*.csv")
Set Ws = Sheets("+65")
Application.ScreenUpdating = False
With Ws
Do While Len(strFile) > 0
Workbooks.Open Filename:=strSourcePath & strFile, Format:=2
With ActiveWorkbook.ActiveSheet
vDB = .UsedRange
End With
ActiveWorkbook.Close
Set rngT = .Range("a" & Rows.Count).End(xlUp)(2)
rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
strFile = Dir
Loop
End With
Application.ScreenUpdating = False
End Sub