How to open a very large .dat file using excel vba - vba

Question

I have some data files (.dat) that are very large (exceed the 1,048,000 rows Excel allows). I can't quite figure out what the problem is with the attempted macros (originally written for text files with "," delimiter, not .dat files with tab delimiter). The macro works, however it causes the data to be compiled into one column (ex. supposed to be 5 columns, now 1 column with all the numbers as a long text string). Is there a better way to open a very large .dat file, split it up and import it into separate worksheets while keeping the data in separate columns using the tab delimiter?
Sub ImportBigFile()
Dim N As Long
Dim Lim As Long
Dim SS() As String
Dim S As String
Dim R As Long
Dim C As Long
Dim WS As Worksheet
Dim FNum As Integer
Dim FName As String
FName = "C:\Folder 1\Folder 2\File.dat"
FNum = FreeFile
With ActiveWorkbook.Worksheets
Set WS = .Add(after:=.Item(.Count))
End With
Lim = WS.Rows.Count
Open FName For Input Access Read As #FNum
R = 0
Do Until EOF(FNum)
R = R + 1
Line Input #FNum, S
SS = Split(S, "\t", -1)
For C = LBound(SS) To UBound(SS)
WS.Cells(R, C + 1).Value = SS(C)
Next C
If R = Lim Then
With ActiveWorkbook.Worksheets
Set WS = .Add(after:=.Item(.Count))
End With
R = 0
End If
Loop
End Sub

Answer 1

SS = Split(S, "\t", -1)
should be
SS = Split(S, chr$(9), -1)
Assuming your tab is ascii

Answer 2

This fixes 2 issues, and improves performance
As mentioned, the delimiter used in Split (vbTab)
You open the file for Input but never close it
Uses an array to convert to range format, then places it on the range in one operation
Test file used contains 3,145,731 Rows and 5 Cols (122 Mb)
your code: 3.9 min (231.755 sec)
this code: 1.1 Min ( 64.966 sec)
Option Explicit
Public Sub ImportBigFile2()
Const fName = "C:\Folder 1\Folder 2\File.dat"
Dim maxR As Long, maxC As Long, wsCount As Long, arr As Variant, rng As Variant
Dim fNum As Long, fText As String, ws As Worksheet, ln As Variant, nextR As Long
Dim i As Long, r As Long, c As Long, t As Double, ubArr As Long
t = Timer: fNum = FreeFile: maxR = ThisWorkbook.Worksheets(1).Rows.Count
Open fName For Input Access Read As #fNum
fText = Input$(LOF(1), 1)
Close #fNum
arr = Split(fText, vbCrLf): ubArr = UBound(arr)
maxC = UBound(Split(arr(0), vbTab)) + 1
wsCount = ubArr \ maxR + 1: nextR = 0
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets
For i = 1 To wsCount
Set ws = .Add(After:=.Item(.Count))
ReDim rng(1 To maxR, 1 To maxC)
For r = 1 To maxR
ln = Split(arr(nextR), vbTab)
For c = 1 To UBound(ln) + 1
rng(r, c) = ln(c - 1)
Next
nextR = nextR + 1: If nextR > ubArr Then Exit For
Next
ws.Range(ws.Cells(1, 1), ws.Cells(maxR, maxC)) = rng
Next
End With
Application.ScreenUpdating = True
Debug.Print "Time: " & Format(Timer - t, "#,###.000") & " sec" 'Time: 64.966 sec
End Sub
Before (CSV file)
After