VBA slow due to pulling data from files - excel

Question

My Excel VBA script pulls data from other files, and my script isn't very good. How can I speed the file up?
So I pull 11x2737 data from each of 8 text files and pull 3x70101 from each of another 8 text files. It takes over 2 minutes to do this.
Set conFolder = CreateObject("Scripting.FileSystemObject")
For Each conFile In conFolder.GetFolder(folderName).Files
If InStr(conFile, "con.dat") > 0 Then
Set WorkB4 = Workbooks.Open(Filename:=conFile)
WorkB4.Activate
WorkB4.Application.DisplayAlerts = False
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1)), _
TrailingMinusNumbers:=True
Cells.Select
Selection.Copy
conBottle = Left(Right(conFile, 9), 1)
WorkB1.Activate
Sheets("Bot" & conBottle).Select
Range("A1").Select
ActiveSheet.Paste
WorkB4.Application.DisplayAlerts = True
WorkB4.Application.CutCopyMode = False
WorkB4.Close SaveChanges:=False
End If
Next
I'm hoping there's a way to pull this data as fast as possible (ideally within 5 seconds).

Answer 1

Avoiding Select and Activate, turning off ScreenUpdating, and skipping the clipboard should help, but typically the biggest bottleneck would be network or disk I/O: if the text files are on a network share, try copying them locally first.
So I refactored the code a bit, and there's only WorkB1 I couldn't work out where it came from.
None of this is tested, but it should give you a workable starting point.
Option Explicit
Public Sub ProcessFiles(ByVal Path As String)
Dim WorkB1 As Workbook ' <~
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
On Error GoTo CleanFail
With CreateObject("Scripting.FileSystemObject")
Dim conFolder As Object
Set conFolder = .GetFolder(Path)
Dim conFile As Variant '/String
For Each conFile In conFolder.Files
If InStr(conFile, "con.dat", VbCompareMethod.vbTextCompare) > 0 Then
ProcessFile conFile, WorkB1
End If
Next
End With
CleanExit:
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
Exit Sub
CleanFail:
Debug.Print Err.Description
Resume CleanExit
End Sub
Private Sub ProcessFile(ByVal conFile As String, ByVal WorkB1 As Workbook)
On Error GoTo CleanFail
Dim book As Workbook
Set book = Workbooks.Open(conFile)
Dim sheet As Worksheet
Set sheet = book.Worksheets(1)
Dim dataRange As Range
Set dataRange = sheet.Columns(1)
Const NumberOfColumns As Long = 11
dataRange.TextToColumns _
destination:=sheet.Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlTextQualifierDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False, _
FieldInfo:=Array( _
Array(1, 1), _
Array(2, 1), _
Array(3, 1), _
Array(4, 1), _
Array(5, 1), _
Array(6, 1), _
Array(7, 1), _
Array(8, 1), _
Array(9, 1), _
Array(10, 1), _
Array(11, 1)), _
TrailingMinusNumbers:=True
Dim dataRows As Long
dataRows = sheet.Range("A" & sheet.Rows.Count).End(xlUp).Row
Dim sourceRange As Range
Set sourceRange = sheet.Range("A1", sheet.Cells(dataRows, NumberOfColumns))
Debug.Print "Source: " & sourceRange.Address(External:=True)
Dim conBotName As String
conBotName = Left$(Right$(conFile, 9), 1)
Dim conBotSheet As Worksheet
Set conBotSheet = WorkB1.Worksheets("Bot" & conBotName)
Dim destination As Range
Set destination = conBotSheet.Range("A1", conBotSheet.Cells(dataRows, NumberOfColumns))
Debug.Print "Destination: " & destination.Address(External:=True)
destination.Value = sourceRange.Value
book.Close SaveChanges:=False
CleanExit:
Exit Sub
CleanFail:
Debug.Print Err.Description
Resume CleanExit
End Sub