VBA slow due to pulling data from files

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).

[How to avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — BigBen, May 28 '21 at 02:11
Readers are generally sympathetic to people with a bullying boss or limited employment protections, but if you mention such things in your post, what you mean is that future employment consequences for you are the fault of volunteers who fail to help you sufficiently. This is not an acceptable way to engage here. — halfer, May 28 '21 at 22:25
If you are being bullied at work, there are many resources on the internet that can help you. I would start with Reddit - r/cscareersquestions (Americas) or r/cscareersquestionseu (Europe) might be reasonable places to start. — halfer, May 28 '21 at 22:27

score 4 · Answer 1 · answered May 28 '21 at 03:24

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

VBA slow due to pulling data from files

1 Answers1