• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to import TXT file with more than 1048576 rows of data in Excel

ThrottleWorks

Excel Ninja
Hi,

I have a TXT file. This file has more than 1 million rows of data. I need to import this file in Excel.
For every 50,000 rows of data, macro should create a new worksheet and import the entire data accordingly.

How do I do this. Can anyone please help me in this.
 
Hi,​
you can use the Open filename For Input as # method as described in VBA help (see the samples within this forum as well)​
and use a variable counter and read each text file line with the Line Input # statement for example.​
Check the end of file with the EOF function and you can use for example the Split function to parse the data …​
 
I have a TXT file. This file has more than 1 million rows of data. I need to import this file in Excel.
For every 50,000 rows of data, macro should create a new worksheet and import the entire data accordingly.
A million+ rows of data is difficult for a human to digest on a sheet let alone 50,000 rows of data.
What are you going to do with this data?!
I very strongly suspect that you can leave this amount of data in the background in Excel, transform it the way you need, and present only limited data onto a worksheet which a human can view/manipulate and understand.
So again, what are you going to do with this data?
 
Hi @p45cal sir, thanks a lot for the help. This is a requirement came at me. At present user is exporting data manually in Excel.
User split the TXT file manually and then import in Excel. I will check exact usage of data.
 
Hi,
I am using below code to split files however facing issues with the code.
Macro creates a new workbook and gest stuck at 'Line Input #FileNum, ResultStr' this line.
I tried giving different input files to check but still facing same issue.
Can anyone please help me in this.

Code:
'https://stackoverflow.com/questions/12124751/vba-code-to-import-oversized-text-file-to-excel
Sub Tester()
    Const LINES_PER_SHEET As Long = 500000
    Dim ResultStr As String
    Dim FileName As String
    Dim FileNum
    Dim Counter As Long, r As Long
    Dim wbNew As Excel.Workbook
    Dim arr()
    Dim mypath As String
   
    mypath = ThisWorkbook.Path
   
    FileName = "M:\DDD\go2gctus20211231.txt"
    'InputBox("Please enter the Text File's name, e.g. ifs_ytd_fut") & ".txt"
    If FileName = "" Then Exit Sub
   
    FileNum = FreeFile()
    Open FileName For Input As #FileNum

    Set wbNew = Workbooks.Add(template:=xlWorksheet)
    wbNew.SaveAs (mypath & "/Extract.xls")

    Counter = 0
    r = 0

    ReDim arr(1 To LINES_PER_SHEET, 1 To 1)

    Do While Not EOF(FileNum)
        If Counter Mod 1000 = 0 Then
            Application.StatusBar = "Importing Row " & _
             Counter & " of text file " & FileName
        End If

        Counter = Counter + 1
        r = r + 1
        Line Input #FileNum, ResultStr
        If Left(ResultStr, 1) = "=" Then ResultStr = "'" & ResultStr

        arr(r, 1) = ResultStr
        If r = LINES_PER_SHEET Then
            ArrayToSheet wbNew, arr
            r = 0
        End If
    Loop

    If Counter Mod LINES_PER_SHEET > 0 Then ArrayToSheet wbNew, arr

    Close #FileNum
    Application.StatusBar = False


End Sub
Sub ArrayToSheet(wb As Workbook, ByRef arr)
    Dim r As Long
    r = UBound(arr, 1)
    With wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))
        .Range("A1").Resize(r, 1).Value = arr
    End With
    ReDim arr(1 To r, 1 To 1)
End Sub
 
Last edited:
Hi,

I tried running the macro with another file. It is getting completed however only first row of the file is getting imported.
Not able to understand issue, can anyone please help me in this. Please see below code for your reference.

Code:
'https://stackoverflow.com/questions/12124751/vba-code-to-import-oversized-text-file-to-excel
Sub Tester()
    Const LINES_PER_SHEET As Long = 500000
    Dim ResultStr As String
    Dim FileName As String
    Dim FileNum
    Dim Counter As Long, r As Long
    Dim wbNew As Excel.Workbook
    Dim arr()
    Dim mypath As String
    
    mypath = ThisWorkbook.Path
    
    FileName = "M:\DDD\Dummy.txt"
    'InputBox("Please enter the Text File's name, e.g. ifs_ytd_fut") & ".txt"
    If FileName = "" Then Exit Sub
    
    FileNum = FreeFile()
    Open FileName For Input As #FileNum

    Set wbNew = Workbooks.Add(template:=xlWorksheet)
    wbNew.SaveAs (mypath & "/Extract.xls")

    Counter = 0
    r = 0

    ReDim arr(1 To LINES_PER_SHEET, 1 To 1)
    Do While Not EOF(FileNum)
        If Counter Mod 1000 = 0 Then
            Application.StatusBar = "Importing Row " & Counter & " of text file " & FileName
        End If

        Counter = Counter + 1
        r = r + 1
        Line Input #FileNum, ResultStr
        'If Left(ResultStr, 1) = "=" Then ResultStr = "|" & ResultStr
        If Left(ResultStr, 1) = "=" Then ResultStr = "," & ResultStr
        
        arr(r, 1) = ResultStr
        If r = LINES_PER_SHEET Then
            ArrayToSheet wbNew, arr
            r = 0
        End If
    Loop

    If Counter Mod LINES_PER_SHEET > 0 Then ArrayToSheet wbNew, arr

    Close #FileNum
    MsgBox "Done!"
    Application.StatusBar = False
End Sub
Sub ArrayToSheet(wb As Workbook, ByRef arr)
    Dim r As Long
    r = UBound(arr, 1)
    With wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))
        .Range("A1").Resize(r, 1).Value = arr
    End With
    ReDim arr(1 To r, 1 To 1)
End Sub
 
Maybe the source text file is particular (1) but, as guessing can't be coding, I could help only​
if you attach a source text file and the beginning of the expected result workbook​
with more details / explanation according to what the VBA procedure must do …​
If the file is too big to be joined directly within this forum then link it on a files host website like Dropbox.​
(1) Some text files contains some 'bad character' which makes the classic VBA methods believe the end of file is reached​
before the real end of file. So in this particular case the way to go is to read the file via the FSO activeX …​
 
Hi @Marc L , thanks for the help.

Attaching files is not allowed from my environment. Dummy files won't help much.
I am trying to do something like below.

1) I have folder with text files
2) I need to import all the text files one by one, delimit the data, give headers to the imported data and save each imported file as a workbook
3) Delimited in these files is pipe character
4) I have a mapping worksheet in my macro, number of fields in the file will remain same, once I import the data, I paste the headers
5) Some of the text files when imported will cross excel row size limit i.e. 1048576 rows
6) For this reason I am trying to get a code which will split the text file and import it one by one in excel and delimit the data
7) For example, if a text file has data for 1 million rows, macro should spilt that text file in 20 and import the file one by one
8) Once imported, macro should save 20 worksheets in a single file and save that file
9) For less heavy files, I have the code, it is importing files and delimiting, delimiting code taken from Forum only
10) I am facing issues while importing heavy files.



Below code is related to first part where text files are in less in size.
Code:
'https://stackoverflow.com/questions/16945348/excel-csv-file-with-more-than-1-048-576-rows-of-data
Option Explicit
'Option Private Module
Sub ImportTextFile()
    Application.ScreenUpdating = False
    
    Dim TempRng As Range
    Dim TRng As Range
    Dim TempLr As Long
    Dim CurFile As Workbook
    Dim TextFile As Workbook
    Dim OpenFiles() As Variant
    Dim i As Integer
    
    Dim MacroBook As Workbook
    Dim MapSht As Worksheet
    Dim TempSht As Worksheet
    
    Set MacroBook = ThisWorkbook
    Set MapSht = MacroBook.Worksheets("Mapping")
    
    MapSht.Range("XFC1").Value = Now()
        
    Set CurFile = ActiveWorkbook
    Set TempSht = CurFile.Worksheets("Temp")
    TempSht.Cells.Clear
    
    Call Select_Folder
    
    TempLr = MapSht.Range("C" & Rows.Count).End(xlUp).Row
    Set TempRng = MapSht.Range(MapSht.Cells(2, 4), MapSht.Cells(TempLr, 4))
    
    For Each TRng In TempRng
        TRng.Select
        If MapSht.Cells(TRng.Row, 6) = "txt" Then 'Extension
            If MapSht.Cells(TRng.Row, 7) < 10000 Then 'Size in KB
                Set TextFile = Workbooks.Open(MapSht.Cells(TRng.Row, 4) & "\" & MapSht.Cells(TRng.Row, 5))
                TextFile.Sheets(1).Range("A1").CurrentRegion.Copy Destination:=TempSht.Range("A1")
                Application.CutCopyMode = False
                TextFile.Close
                
                Call SplitName
                
                MapSht.Range("A2:A111").Copy
                TempSht.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                Application.CutCopyMode = False
            End If
        End If
    Next TRng
    
    Application.ScreenUpdating = True
    MapSht.Range("XFC2").Value = Now()
    MapSht.Range("XFC3").Value = "=XFC2-XFC1"
    MapSht.Range("XFC3").NumberFormat = "hh:mm:ss"
    Application.StatusBar = ""
    Sub
Public Function GetFiles() As Variant
    GetFiles = Application.GetOpenFilename(Title:="Select File(s) to Import", MultiSelect:=True)
End Function
Sub SplitName()
    Dim MacroBook As Workbook
    Dim MapSht As Worksheet
    Dim TempSht As Worksheet
    Dim TempLr As Long
        
    Dim MyArray() As String, MyString As String, i As Variant, N As Integer
    Dim TempRng As Range
    Dim TRng As Range
    
    Set TempSht = ThisWorkbook.Worksheets("Temp")
    TempLr = TempSht.Cells(Rows.Count, 1).End(xlUp).Row - 1 'is the -1 necessary?
    TempSht.Range("A2:A" & TempLr).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="|"
End Sub
 
Can you link a source text file in a private conversation in order I can check it ?​
If you can't all I can say is to try to read the file in binary mode or to use FSO …​
 
Hi @Marc L , created some dummy data. Could you please check the file if you get time.
PS - Original data is in similar manner with thousand of rows.
 

Attachments

  • Sample.txt
    1.2 KB · Views: 5
Last edited:
Nothing weird within your sample text file …​
According to its small size first try a classic way (simplified before to go to the multi sheets split way)​
in order to see if it's ok on your side :​
Code:
Sub Demo0()
  Const D = "|"
    Dim V, F&
        V = ThisWorkbook.Path & "\Sample.txt":  If Dir(V) = "" Then Beep: Exit Sub
        F = FreeFile
        Open V For Input As #F
        V = Split(Input(LOF(F), #F), vbCrLf)
        Close #F
    For F = 0 To UBound(V)
        If InStr(V(F), D) = 0 Then V(F) = False
    Next
        V = Filter(V, False, False)
        Application.ScreenUpdating = False
    With Worksheets(1).[A2].Resize(UBound(V) + 1)
        .Cells(0).CurrentRegion.Offset(1).Clear
        .Value2 = V
        .TextToColumns , 1, xlTextQualifierNone, , , , , , True, D, , "."
    End With
        Application.ScreenUpdating = True
End Sub
 
Hi @Marc L thanks for the help. Tried your code. Getting bug at below line as application defined or object defined error.

.Value2 = V

Checked ? Dir(V) = Sample.txt. coming correctly.
 
Still according to your sample text file a new VBA demonstration creating a new workbook​
and parsing data to a new worksheet every 5 data rows to paste to a brand new module :​
Code:
Const D = "|"
  Dim L&, T$(1 To 5)

Private Sub AllocateData()
    Dim B As Boolean
        B = ActiveWorkbook.Name = ThisWorkbook.Name:  If B Then Workbooks.Add xlWBATWorksheet
    With ActiveWorkbook.Sheets
            If Not B Then .Add , .Item(.Count)
        With .Item(.Count).[A2].Resize(L)
             .Value2 = T
             .TextToColumns , 1, xlTextQualifierNone, , , , , , True, D, , "."
        End With
    End With
        L = 0
End Sub

Sub Demo1()
    Dim N$, F%, S$
        N = ThisWorkbook.Path & "\Sample.txt":  If Dir(N) = "" Then Beep: Exit Sub
        F = FreeFile
    With Application
       .ScreenUpdating = False
        Open N For Input As #F
    While Not EOF(F)
        Line Input #F, S
        If InStr(S, D) Then L = L + 1: T(L) = S: If L = UBound(T) Then AllocateData
    Wend
        Close #F
        If L Then AllocateData
       .DisplayAlerts = False
        ActiveWorkbook.SaveAs Replace(N, ".txt", ""), 51
       .DisplayAlerts = True
       .ScreenUpdating = True
    End With
End Sub
 
Hi @Marc L , thanks for the help, facing some issues with my real data. Please give me some time to check in details.
I will post my reply with more details. With this code, macro imports only the first line from the text file.

I checked the same updated code with sample data I have provided. It is working perfect.
My real data has 110 fields. Will that have any impact. I am trying to edit your code to check.
 
No such impact but as it depends exactly on which issues you are facing …​
But according to your sample text file I'm pretty sure your original text file was created by foot rather than hand !​
Use a specific text editor like Notepad++ in order to see the special characters …​
 
Try first this new demonstration with your sample text file before to try an original one​
without forgetting to update the upper bound of the array variable T from 5 to 50 000,​
working under Windows only because of the activeX and to paste to a brand new module :​
Code:
Const D = "|"
  Dim C&, L&, T(1 To 5)

Private Sub ParseData()
        C = C + 1
    With ActiveWorkbook.Sheets(C).[A2].Resize(L)
        .Value2 = T
        .TextToColumns , 1, xlTextQualifierNone, , , , , , True, D, , "."
    End With
        L = 0
End Sub

Sub Demo2()
    Dim F$, V, R@, W
        F = ThisWorkbook.Path & "\Sample.txt":  If Dir(F) = "" Then Beep: Exit Sub
        V = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(F).ReadAll, vbCrLf)
    For R = 0 To UBound(V)
        If InStr(V(R), D) = 0 Then V(R) = False
    Next
        V = Filter(V, False, False):  If UBound(V) < 0 Then Beep: Exit Sub
        C = 0
        R = (UBound(V) + 1) / UBound(T)
    With Application
       .ScreenUpdating = False
       .SheetsInNewWorkbook = Fix(R) - (R - Fix(R) > 0)
        Workbooks.Add
       .SheetsInNewWorkbook = 1
    For Each W In V
        L = L + 1:  T(L) = W:  If L = UBound(T) Then ParseData
    Next
        If L Then ParseData
       .DisplayAlerts = False
        ActiveWorkbook.SaveAs Replace(F, ".txt", ""), 51
       .DisplayAlerts = True
       .ScreenUpdating = True
    End With
End Sub
 
Hi @Marc L , thanks a lot for the help. Sorry to trouble you on this.
Code is working perfect for the sample file I have uploaded but importing only first line with real data.

This is how my real data looks, please give me 10 minutes to upload a sample text file with this data.
This is only one line data, highlighted part is header and footer if I can describe in such way.

PS - Edited later, code is working perfect with new sample data too.
As you mentioned, must be some issues with the original file.
I ran the code with below data, runs perfect, but issues with real data only.
Have prepared new sample data based on real data only, just replaced values.
If I run the macro on real data, it imports only the first line.

IopiPmtIopiIOP IP QAZwIOPxUJM9999129903MAR99
9999|P|99.99|99991299|99991299|IOPUP|AL|996001808.1137356.99IOPG|IOP.00000901.996001808.99IOPG||1137356.99P|P|974||ALD|AgPcyLePdDiIOPcloIOPure|ABCD|ABCDOWP|ABCD|ABCDOWP|||00000901.996001808|99991299|POR|IOPTLP|EQLB|QAZwsxEDCrfvTGB IOPyIOPtem|ZZ|ZZ||||620|99991299||B|99990518|99991299|D|P|P|P|12.25000000|2.00000000|||BP4MX14|||||WSXRFV|1.29582000|1.00000000|-117294.00000000|U|0.00000000|0.00000000|0.00000000|0.00000000|0.00000000|99991299|1.29582000|-151991.91108000|1.29582000|-151991.91108000|1.00000000|99991299|0.00000000|WSXRFV|99991299|T|IOP|||||||UIOPD|0.00000000|0.00000000|0.00000000|U|0.00000000|0.00000000|0.00000000|0.00000000|0.00000000|0.00000000|UIOPD|99991299||0.00000000|0.00000000||||||||||00000901||
IopiPmtIopiIOP IP QAZwIOPxUJM9999129903JAP220003227WIOPXedcRFV
 

Attachments

  • Sample.txt
    3.6 KB · Views: 6
Last edited:
Same windows format text file but maybe the originals are not so just check with a text editor like NotePad++​
in order to see what is the end of line sequence.​
With an original text file I can figure out with a snap but without it's just a guessing challenge for a mind readers forum …​
 
Hi @Marc L I agree with you, my apologies for not uploading original file. Thanks a lot for all the help.
It is not allowed hence I would have uploaded at the first post itself.
One doubt I just had is, macro is importing same files without any issue with a different code.
Files are getting imported, delimited perfectly. Please see below code for your reference.

This code imports each file from the folder, delimits it, major issues with this code is, size limit.
Not able to understand, why macro gives error when we try other method.

Code:
'https://stackoverflow.com/questions/16945348/excel-csv-file-with-more-than-1-048-576-rows-of-data
Option Explicit
Option Private Module
Public MyFileName As String
Public MyFolderPath As String
Sub ImportTextFile()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.CutCopyMode = False
    
    Dim TempRng As Range
    Dim TRng As Range
    Dim TempLr As Long
    Dim CurFile As Workbook
    Dim TextFile As Workbook
    Dim OpenFiles() As Variant
    Dim i As Integer
    
    Dim MacroBook As Workbook
    Dim MapSht As Worksheet
    Dim TempSht As Worksheet
    Dim MacroSht As Worksheet
    
    Set MacroBook = ThisWorkbook
    Set MapSht = MacroBook.Worksheets("Mapping")
    Set MacroSht = MacroBook.Worksheets("Macro")
    
    MapSht.Range("XFC1").Value = Now()
        
    Set MacroBook = ThisWorkbook
    Set TempSht = MacroBook.Worksheets("Temp")
    TempSht.Cells.Clear
    
    Call Select_Folder
    
    TempLr = MapSht.Range("C" & Rows.Count).End(xlUp).Row
    Set TempRng = MapSht.Range(MapSht.Cells(2, 4), MapSht.Cells(TempLr, 4))
    
    For Each TRng In TempRng
        'MapSht.Select
        'TRng.Select
        If MapSht.Cells(TRng.Row, 6) = "txt" Then 'Extension
            If MapSht.Cells(TRng.Row, 7) < 50000 Then 'Size in KB
                MyFileName = MapSht.Cells(TRng.Row, 8)
                MyFolderPath = MapSht.Cells(TRng.Row, 4)
                
                Set TextFile = Workbooks.Open(MapSht.Cells(TRng.Row, 4) & "\" & MapSht.Cells(TRng.Row, 5))
                TextFile.Sheets(1).Range("A1").CurrentRegion.Copy Destination:=TempSht.Range("A1")
                Application.CutCopyMode = False
                TextFile.Close
                
                Call SplitName
                Call Save_Temp_Sheet
                MapSht.Cells(TRng.Row, 9) = "Imported"
                MsgBox MyFileName & " processed!"
            End If
        End If
    Next TRng
    
    MacroSht.Select
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.CutCopyMode = True
    
    MapSht.Range("XFC2").Value = Now()
    MapSht.Range("XFC3").Value = "=XFC2-XFC1"
    MapSht.Range("XFC3").NumberFormat = "hh:mm:ss"
    Application.StatusBar = ""
    MsgBox "This macro has taken " & MapSht.Range("XFC3").Text & " (HH:MM:SS) to convert files from Text to Excel", vbInformation + vbOKOnly, "T0 Analysis"
End Sub
Public Function GetFiles() As Variant
    GetFiles = Application.GetOpenFilename(Title:="Select File(s) to Import", MultiSelect:=True)
End Function
Sub SplitName()
    Dim MacroBook As Workbook
    Dim MapSht As Worksheet
    Dim TempSht As Worksheet
    Dim TempLr As Long
        
    Dim MyArray() As String, MyString As String, i As Variant, N As Integer
    Dim TempRng As Range
    Dim TRng As Range
    
    Set TempSht = ThisWorkbook.Worksheets("Temp")
    TempLr = TempSht.Cells(Rows.Count, 1).End(xlUp).Row - 1 'is the -1 necessary?
    If TempLr > 1 Then
        TempSht.Range("A2:A" & TempLr).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="|"
    End If
End Sub
 
Back
Top