Extracting a string from a specific position from a DAT file

Question

Hello everyone I'm new in VBA programming but I've used Excel for 2 years, I want to build a program that can extract a String (30 pos long) from an specific position of every line (pos 15) and place it into a cell in my worksheet, sounds easy but I need to extract every string of every line from a DAT archive that contains 22,157,838 records, I have to place 1,048,575 records on a column and Offset to the start of the next column, I really appreciate any help, here's my code:

Sub FirstMACR_ATV()
    Dim myFile As String
    textline As String
    CUENTA As String
    myFile = "C:\Users\s3850630\Desktop\EXPMST.dat"
    Open myFile For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        CUENTA = Mid(textline, 15, 30)
End Sub

Thanks :)

Answer 1

My answer is just like Tim Williams's only different (great minds think like mine). I added an Application.StatusBar message to ease the mind of the poor guy that is going to have to wait for this to process. I also write all the data at once.

You might want to experiment with the MAX_ROWS_PER_COLUMN. 100K might perform better than 1000k (for daily use, the processing time will be roughly the same). In any case, a 316 MB Excel file is not Ideal. I recommend using a database.

Sub FirstMACR_ATV()
    Dim t As Long: t = Timer
    Const MAX_ROWS_PER_COLUMN AS Long = 1000000
    Dim r As Long, c As Long
    Dim myFile As String, textline As String
    Dim results() As Variant
    myFile = "C:\Users\s3850630\Desktop\EXPMST.dat"

    Open myFile For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        r = r + 1

        If r > MAX_ROWS_PER_COLUMN Or c = 0 Then
            c = c + 1
            r = 1
            ReDim Preserve results(1 To MAX_ROWS_PER_COLUMN, 1 To c)
        End If

        If r = 50000 Then Application.StatusBar = "Processing record #" & (r * c) & " " & Round(Timer - t, 2) & " Seconds"
        results(r, c) = Mid(textline, 15, 30)
    Loop
    Close #1
    Worksheets("Sheet1").Range("A1").Resize(UBound(results), UBound(results, 2)).Value = results
    Debug.Print Round(Timer - t, 2)
End Sub