Excel VBA optimise macro to convert file to .xlsx then TextToColumns

Question

I wrote a macro today for a first time in a few years and it appears to be running slowly. The macro takes a file with a .datalog extension, converts it to .xlsx, open the .xlsx file then performs text to columns on the data in range A:A. The macro works fine but it appear to be slow. If I run the text to columns manually in the workbook, it appears to process much faster than through VBA. I have run the standard Application-level configs to optimise but it still appears to be slow - when run manually, it takes a matter of seconds whereas it takes roughly 1 minute through VBA. My code is below. Is there anything I can add to it to speed it up? Thanks.

Sub SecondAttempt()

    Dim oWbk As Workbook
    Dim oWbkNew As Workbook
    Dim sPath, sFile As String
    Dim iWorkbookCount As Integer
    Dim sNewFileName As String

    'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    sPath = ActiveWorkbook.Path & "\data\" 'location of files
    sFile = Dir(sPath & "*.datalog") 'change or add formats

    ' will start LOOP until all files in folder sPath have been looped through
    Do While sFile <> ""

        ' open file
        Set oWbk = Workbooks.Open(sPath & "\" & sFile)

        ' create new name
        sNewFileName = sPath & Replace(oWbk.Name, ".datalog", ".xlsx")

        ' save to xlsx (alerts disabled to allow automatic overwrite)
        Application.DisplayAlerts = False
        oWbk.SaveAs FileName:=sNewFileName, FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = True

        ' close workbook
        oWbk.Close True

        ' open file
        Set oWbkNew = Workbooks.Open(sNewFileName)
        oWbkNew.Worksheets(1).Columns("A:A").Select
        ' convert to columns
        Selection.TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=True


        ' close workbook
        oWbkNew.Close True

        ' increment count
        iWorkbookCount = iWorkbookCount + 1

        sFile = Dir

    Loop

    'Message Box when tasks are completed
    MsgBox "Complete! " & iWorkbookCount & " Workbooks converted"

    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True

End Sub

This is probably a better question for [Code Review](https://codereview.stackexchange.com/) rather than SO. I don't see anything suspect in this code, however. You *should* add more detail about how you come up with the length of time (is this a guess, or do you have observable metrics?), and what is your process of doing it manually? — David Zemens, Jul 20 '18 at 14:53
For instance, merely *opening* the file is probably expensive in terms of time. If you're doing this manually, are you accounting for the length of time it takes to open the file and save it, too? Because your macro is doing end-to-end. It's not simply applying the TextToColumns. So, you need to ensure you're comparing like things and still getting inconsistent result. — David Zemens, Jul 20 '18 at 14:54

score 1 · Accepted Answer · answered Jul 20 '18 at 15:10

One idea would be rather than opening and saving the .datalog file in Excel (both of which are probably time-consuming operations) would be to read the text file as a stream and just dump that into a new workbook, then apply text to columns. I suspect that would be considerably faster.

Option Explicit

Sub ttc()
Dim path As String, outputFileName As String, text As String
Dim newWorkbook As Workbook
Dim ws As Worksheet
Dim FF As Long
Dim rng As Range, r As Long
Set newWorkbook = Workbooks.Add()
Set ws = newWorkbook.Worksheets(1)

path = "C:\debug\file.datalog"
outputFileName = Replace(path, ".datalog", ".xlsx")
FF = FreeFile
r = 1
Open path For Input As FF
Do While Not EOF(FF)
    Line Input #FF, text
    Set rng = ws.Cells(r, 1)
    rng.Value = text
    r = r + 1
Loop
Close FF

ws.Cells(1, 1).CurrentRegion.TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=True

newWorkbook.SaveAs outputFileName, FileFormat:=xlOpenXMLWorkbook
newWorkbook.Close
End Sub

Thank you, David. I incorporated your approach into my code and got about a 30% increase in speed. That's it working well enough for me. Cheers! — U4EA, Jul 23 '18 at 22:26

Excel VBA optimise macro to convert file to .xlsx then TextToColumns

1 Answers1