Anyway to speed up this code

[hgus393]

Hi all,

I have written some code to import a non-delimited text file (dat). It works but it is so sloooow (take 15 minutes on a computer with quad core processors). The text file itself is about 2200 rows and 14 coulmns. Can anyone see how I could speed up this code?

Sub TxtfileImport()
Dim i As Long
Dim InFile As String, Str As String
Dim FileNum As Integer, LineLen As Integer
Dim DDate As Date
Application.ScreenUpdating = False
Application.EnableEvents = False
DDate = InputBox("Date please", "Date")
 
FileNum = 1
InFile = "C:\temp\Test_" & Format(DDate, "YYYYMMDD") & ".dat"
Open InFile For Input As FileNum
With ThisWorkbook.Worksheets("Sheet1")
Do While Not EOF(FileNum)
Line Input #FileNum, Str
If Left(Str, 2) = "02" Then
            Cells(i, 1) = Left(Str, 2)
            Cells(i, 2) = Mid(Str, 3, 20)
            Cells(i, 3) = Mid(Str, 23, 12)
            Cells(i, 4) = Mid(Str, 35, 8)
            Cells(i, 5) = Mid(Str, 43, 30)
            Cells(i, 6) = Mid(Str, 73, 30)
            Cells(i, 7) = Mid(Str, 103, 15)
            Cells(i, 8) = Mid(Str, 118, 1)
            Cells(i, 9) = Mid(Str, 119, 16)
            Cells(i, 10) = Mid(Str, 135, 16)
            Cells(i, 11) = Mid(Str, 151, 16)
            Cells(i, 12) = Mid(Str, 167, 16)
            Cells(i, 13) = Mid(Str, 183, 16)
            Cells(i, 14) = Mid(Str, 199, 16)
End If
i = i + 1
Loop
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Cheers

Rob

 

[brettdj]

Rob,

This should improve the speed.
- mainly by using variant arrays as opposed to cell by cell writes
- using the string versions of Mid (Mid$) and Left(Left$) will help somewhat as well

I replaced the "Open" approach with the FileScriptingObject mainly as I wanted to count the lines for the variant array upfront rather than test for a redim every 100 rows or so.

Please add back in your DDate code in the filename, I removed it for testing

hth

Dave

Sub TxtfileImport()
    Dim objFso
    Dim objTF
    Dim i As Long
    Dim X()
    Dim ArrLines, aLine
    Dim InFile As String
    Dim DDate As Date
    Dim lngRows

    With Application
        .ScreenUpdating = False
        .Application.EnableEvents = False
    End With
    'DDate = InputBox("Date please", "Date")
    FileNum = 1
    InFile = "C:\temp\test.dat"

    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objTF = objFso.OpenTextFile(InFile)
    ArrLines = Split(objTF.ReadAll, vbCrLf)
    ReDim X(1 To UBound(ArrLines, 1) + 1, 1 To 14)

    For Each aLine In ArrLines
        If Left$(aLine, 2) = "02" Then
            i = i + 1
            X(i, 1) = Left$(aLine, 2)
            X(i, 2) = Mid$(aLine, 3, 20)
            X(i, 3) = Mid$(aLine, 23, 12)
            X(i, 4) = Mid$(aLine, 35, 8)
            X(i, 5) = Mid$(aLine, 43, 30)
            X(i, 6) = Mid$(aLine, 73, 30)
            X(i, 7) = Mid$(aLine, 103, 15)
            X(i, 8) = Mid$(aLine, 118, 1)
            X(i, 9) = Mid$(aLine, 119, 16)
            X(i, 10) = Mid$(aLine, 135, 16)
            X(i, 11) = Mid$(aLine, 151, 16)
            X(i, 12) = Mid$(aLine, 167, 16)
            X(i, 13) = Mid$(aLine, 183, 16)
            X(i, 14) = Mid$(aLine, 199, 16)
        End If
    Next
    ThisWorkbook.Sheets("Sheet1").[a1].Resize(UBound(X, 1), UBound(X, 2)) = X
    With Application
        .ScreenUpdating = True
        .Application.EnableEvents = True
    End With
    objTF.Close
    Set objTF = Nothing
End Sub

 

[hgus393]

Awesome !!!

Out of curiousity what does:

ArrLines = Split(objTF.ReadAll, vbCrLf)

Do?

Thanks a million!!!

 

[brettdj]

No probs

Out of interest what did your 15 minutes compress to?

This line

ArrLines = Split(objTF.ReadAll, vbCrLf)

Reads the entire text file, then splits(parses) the text file into individual lines using the end of line marker

It has two uses
1) It proves a variable sized array that can then be examined line by line (the aLine code)
2) It sets the maximum array size for X() dynamically. Which is a better approach than testing the array size every so often for redimensioning

Cheers

Dave

 

[Norie]

Couldn't the file be opened directly into Excel?

I know there's no delimiter but it does appear to be fixed width which shouldn't be too hard to parse.

In fact you could do that when opening the file or after it's opened.

Once you've end that you can just filter the data as required.

Just an idea.

 

[brettdj]

Yes. Given as you point out this appears to be a fixed width split combined with a filter for the "02" check.

So given the lack of complex string testing, rearrangement this would also be a valid quick method

Cheers

Dave

 

[Norie]

Dave

I'm not sure my suggestion would work.

The reason for that is because there seems to be some overlap between some fields.

Perhaps it's a bunch of typos but I'm not sure because there's more than one overlap.

Maybe the OP can clarify, though if the code you posted is doing the job then perhaps better not to complicate things.

 

[hgus393]

There are overlaps I am afraid. Some fields may contain nothing in the given position while on the next row it has data. The file itself is dynamic in the sence that it will sometimes work opening directly into excel if the top row has all the pertinent data all across the row (the text file has no headers).

From 15 minutes it now does the trick in about 20 seconds..... amazing!!

Cheers

Rob

Dave

I'm not sure my suggestion would work.

The reason for that is because there seems to be some overlap between some fields.

Perhaps it's a bunch of typos but I'm not sure because there's more than one overlap.

Maybe the OP can clarify, though if the code you posted is doing the job then perhaps better not to complicate things.

 

[ISY]

Hello

Try disabling the unwinding of the sheet:

Application.Calculation = xlCalculationManual
Application.Calculation = xlCalculationAutomatic

 

[brettdj]

There are overlaps I am afraid. Some fields may contain nothing in the given position while on the next row it has data. The file itself is dynamic in the sence that it will sometimes work opening directly into excel if the top row has all the pertinent data all across the row (the text file has no headers).

From 15 minutes it now does the trick in about 20 seconds..... amazing!!

Cheers
Rob

Cool, Thanks Rob

Dave