VBA - text import puts contents all in one cell, need comma delimit instead

Sayre · Aug 28, 2014

Hi, I found and modified the below code and corresponding custom function hoping it will work faster than Workbooks.OpenText on large csv file imports (500K rows+ in some cases). It works great but writes all the data to just one cell in the worksheet which obviously won't work for large files.

How do I modify it so it writes it to the sheet more like a proper comma delimited across man rows/columns? I found threads on split function but not sure if that's the way to go or how to incorporate it if it is. Hoping there's a few simple lines I can add to the below script or custom function. If its more complicated than that could anyone at least point me towards a potential solution? Any hep truly appreciated....

Here's the script...

Code:

Sub TxtImporter2()
Dim f As String, flPath As String
Dim i As Long, j As Long
    Dim sPath As String
Dim ws As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
flPath = Sheets("START").Cells(9, 1).Value & Application.PathSeparator
i = ThisWorkbook.Worksheets.Count
j = Application.Workbooks.Count
f = Dir(flPath & "*.csv")
Do Until f = ""
Workbooks.Add
 Cells(1, 1) = LoadTextFile2(flPath & f)
    Workbooks(j + 1).Worksheets(1).Copy After:=ThisWorkbook.Worksheets(i)
    ThisWorkbook.Worksheets(i + 1).Name = Left(f, Len(f) - 4)
    Workbooks(j + 1).Close SaveChanges:=False
    i = i + 1
    f = Dir
Loop
Application.DisplayAlerts = True
End Sub

Here's the corresponding function...

Code:

 ' \\ Function to return the full content of a text file as a string
Public Function LoadTextFile2(sFile As String) As String
    Dim iFile As Integer
     
Dim lineSplit As Variant

    ' \\ Use FreeFile to supply a file number that is not already in use
    iFile = FreeFile
     ' \\ ' Open file for input.
    Open sFile For Input As #iFile


     
     ' \\ Return (Read) the whole content of the file to the function
    LoadTextFile2 = Input$(LOF(iFile), iFile)
    'Split(Symbols, ".")
     
    Close #iFile
    
End Function

apo · Sep 2, 2014

Hi..

If you have a heap of rows.. probably populating an array and writing that array to the sheet at the end will be faster...

Something like: (used on your sample comma separated data form above)

Code:

Sub Import()
    Dim i As Long, ii As Long, x, xx, s, strFile As String, y
    strFile = Application.GetOpenFilename("CSV Files,*.csv")
    If strFile = "False" Then Exit Sub
    s = Split(CreateObject("scripting.filesystemobject").getfile(strFile).openastextstream.readall, vbCrLf)
    ReDim y(1 To UBound(s), 1 To 1)
    For i = 1 To UBound(s) - 1
        xx = Split(s(i - 1), ",")
        ReDim Preserve y(1 To UBound(s), 1 To UBound(xx))
        For ii = 1 To UBound(xx)
            y(i, ii) = xx(ii - 1)
        Next ii
    Next i
    Sheets("Sheet1").Cells(1, 1).Resize(UBound(y, 1), UBound(y, 2)).Value = y
    With Sheets("Sheet1").UsedRange
        x = .Replace("""", "", xlPart)
    End With
End Sub

DocAElstein · Sep 2, 2014

Hi,

Sayre said:
…………
In any case I ended up going with a very simplified version that works well enough for my needs:
…………!

Happy you have a working solution. But I take an interest as I am playing and learning with similar stuff……..

Sayre said:
It varies. In this case the file is 9 columns and 73 rows but I need the macro to be able to import it regardless of the row/column count.

. My simplified program should have worked, as there were no specific dimensioning. (You would have needed to edit or comment out my first line Option Explicit ). Otherwise the full code simply with Dimensioning things bigger should work: Code:

Sub BasicMacroTextFileToExcelLong() ' Very Simply alternative to the Spreadsheet way using Wizzard, Opening as text File in Excel etc ' 'First Bit can be ommited if fielnames are always known. It basically gets all the File info. 'Note text File And Excel File must not be in the same Directory as you are being asked for it here. On Err GoTo TheEnd ' if anything goes wrong go to the end rather than crasching! ' 'First Bit: TextDataFileName and seperator input Dim Sp As String ' Allocate memory for The seperater used by the Text file Dim DtaFleNm As Variant 'The DataFilename itself is a string. But a vasriant is specified as you may have a Boolean input in the Dialogue boy if the user cancels DtaFleNm = Application.GetOpenFilename(FileFilter:="Hallo,*.txt,") 'The Application Method GetOpenFilename Displays the standard Open dialog box. The optional arguments:= writes a name,limits type of files looked for If DtaFleNm = False Then Exit Sub 'Stops Porgram if User Cancels (which gives the boolean False) Let Sp = Application.InputBox("Enter a separator character.", Type:=2) 'prompts user for separator character If Sp = vbNullString Then Exit Sub 'Stops Porgram if User Cancels (which gives an empty string) 'End First Bit TextDataFileName and seperator input ' ' 'If you want to skip the first bit, delete it or comment it out and type in the text File path and seperator in lines like this: ' Dim DtaFleNm As String ' Let DtaFleNm = ThisWorkbook.Path & "\TextDataFile.txt" ' Dim Sp As String ' Let Sp = "|" ' 'Note: If you do it this way you should put the Active Excel File and Data Text File in the same Directory ' 'Start Main Bit: Get data from text file line by line, then for each line go through every Column. As each data bit is found it is put in the approriate place in the Excel File Dim Rw As Long, StCm As Long, Cm As Long 'Before you start You should select cell Let StCm = ActiveCell.Column 'where you want to start data to come in. Column is then reset in loop Let Rw = ActiveCell.Row 'Row increases downwards so the initial and loop caount can be same variable Dim DtaFleLn As String Dim TxtPs As Long 'text character position in text file looking form left Dim SpPs As Long 'position of seperater lookinf from left Dim TxtDta As String 'String used temporarily for each Text data value Open DtaFleNm For Input As 3 ' Sort of opens up a data highway and gives it route number (here 3) to distinguisch it from any others currently open. (If you do not know how many Highways are already open and have a number, then use instead of a number someting like #HgWyNm here, and HgWyNm everyhwere where the number is. This gives it the next available number (Remember to Dim it at the start also.)) Do Until EOF(3) 'Do until going your at the end of the data highway Line Input #3, DtaFleLn 'Bring in a line from text file(Automatically goes to next line or next part of highway after this command. So we need mo row count for the data file.) If Right(DtaFleLn, 1) <> Sp Then DtaFleLn = DtaFleLn & Sp 'Glue a seperator on the end of the data file line if there is not one there Let Cm = StCm 'go to first column Let TxtPs = 1 ' Initial Data Text Position is at 1 (Ist Left poisition in text file line Let SpPs = InStr(TxtPs, DtaFleLn, Sp) 'Find position of next seperator While SpPs >= 1 'As long as a next Seperator position is found, we go througth columns looking for data Let TxtDta = Mid(DtaFleLn, TxtPs, SpPs - TxtPs) 'this gives the next data value Let ActiveSheet.Cells(Rw, Cm).NumberFormat = "@" 'This is not allways necerssary but can help avoid annoying problems with data turning into times or dates Let ActiveSheet.Cells(Rw, Cm).Value = TxtDta 'Put Text data in excel cell Let ActiveSheet.Cells(Rw, Cm).Value = Trim(ActiveSheet.Cells(Rw, Cm).Value) 'Most not necerssary but can help to clean up data if any extra spaces came in Let TxtPs = SpPs + 1 'Start of next data is just after next seperator Let Cm = Cm + 1 'Increase Excel Column number Let SpPs = InStr(TxtPs, DtaFleLn, Sp) 'Get the next Seperator position by starting at the current data and going right until the next seperator is found Wend 'go to next text data to the right in the data file Line Let Rw = Rw + 1 'Increase row number for Excel(The tecxt file automatically goes to the next row after reading a line Loop 'Go to the next Row in the Data Text file TheEnd: Close 3 'Very important to do this. Shuts highway Off. There can be strange errors if you do not do that. (It is here so that even after an error it will be done End Sub 'BasicMacroTextFileToExcelLong()

. I have a few other programs, and would gladly experiment a bit later, - as I said it helps me in learning.
. If it was possible to send me a text file, similar to that which did not work, I would be happy to try to see why it does not work in my program, and check it out in others. For example send over these 2 free things: FileSnack | Easy file sharing or Box Net,
Remember to select Share after uploading and give us the link they provide.

Or send me a personal message and I will supply you with my Email.

Alan

Rick Rothstein · Sep 2, 2014

Sayre said:
It varies. In this case the file is 9 columns and 73 rows but I need the macro to be able to import it regardless of the row/column count.

Give this code a try... it should work for either type of file you showed us. I have not speed tested it, but I think the code should be pretty fast, even if your file is large. Note, though, it assumes a maximum of 20 columns of data... if that guess is wrong, you can change the blue colored number in the code below to a value that is guaranteed to be larger than the maximum number of columns your data has.

Code:

Sub ImportFile()
  Dim R As Long, C As Long, FileNum As Long
  Dim TotalFile As String, PathAndFileName As String, Delim As String
  Dim Lines As Variant, Data As Variant, Fields As Variant
  If Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row > 1 Or _
     Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column Or _
     Len(Range("A1").Value) > 0 Then
    MsgBox "You have data on the active worksheet... this code can only be run " & _
           "when the active sheet is empty!", vbCritical, "Worksheet Not Empty"
    Exit Sub
  End If
  FileNum = FreeFile
  PathAndFileName = Application.GetOpenFilename("CSV Files(*.csv),*.csv,All Files (*.*),*.*", 1, "Open CSV File")
  Open PathAndFileName For Binary As #FileNum
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  Lines = Split(TotalFile, vbNewLine)
  ReDim Data(1 To UBound(Lines) + 1, 1 To [COLOR=#0000ff][B]20[/B][/COLOR])
  If InStr(TotalFile, vbTab) Then
    Delim = vbTab
  Else
    Delim = ","
  End If
  For R = 0 To UBound(Lines)
    Fields = Split(Lines(R), Delim)
    For C = 0 To UBound(Fields)
      Data(R + 1, C + 1) = Fields(C)
    Next
  Next
  Range("A1").Resize(UBound(Data), UBound(Data, 2)) = Data
End Sub

DocAElstein · Sep 2, 2014

Hi, Rick

Rick Rothstein said:
Give this code a try... it should work for either type of file you showed us..........

. I was just working through your code (as I often do as I always learn from them, thanks!). I have a small problem, that is to say it does not work if the active sheet is empty. Either of these two conditions

Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row > 1 Or _
Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column

return an error.

. But the modified code

Code:

Sub ImportFile()  Dim R As Long, C As Long, FileNum As Long
  Dim TotalFile As String, PathAndFileName As String, Delim As String
  Dim Lines As Variant, Data As Variant, Fields As Variant
  If Len(Range("A1").Value) > 0 Then
    MsgBox "You have data on the active worksheet... this code can only be run " & _
           "when the active sheet is empty!", vbCritical, "Worksheet Not Empty"
    Exit Sub
  End If
  FileNum = FreeFile
  PathAndFileName = Application.GetOpenFilename("CSV Files(*.csv),*.csv,All Files (*.*),*.*", 1, "Open CSV File")
  Open PathAndFileName For Binary As #FileNum
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  Lines = Split(TotalFile, vbNewLine)
  ReDim Data(1 To UBound(Lines) + 1, 1 To 20)
  If InStr(TotalFile, vbTab) Then
    Delim = vbTab
  Else
    Delim = ","
  End If
  For R = 0 To UBound(Lines)
    Fields = Split(Lines(R), Delim)
    For C = 0 To UBound(Fields)
      Data(R + 1, C + 1) = Fields(C)
    Next
  Next
  Range("A1").Resize(UBound(Data), UBound(Data, 2)) = Data
End Sub

. works fine for the CSV data given by the OP.
. It also gives sensible results for the Tab delimited file from the Op, (although they may not be the exact results he wants as some columns are somewhat offset in the final Excel table).

Alan Elston

Rick Rothstein · Sep 2, 2014

DocAElstein said:
Hi, Rick

. I was just working through your code (as I often do as I always learn from them, thanks!). I have a small problem, that is to say it does not work if the active sheet is empty. Either of these two conditions

Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row > 1 Or _
Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column

return an error.

Hmm! I could have sworn I tested for that, but obviously I did not. Thanks for pointing that out.

DocAElstein said:

But the modified code

Code:

Sub ImportFile()  Dim R As Long, C As Long, FileNum As Long
  Dim TotalFile As String, PathAndFileName As String, Delim As String
  Dim Lines As Variant, Data As Variant, Fields As Variant
  [COLOR=#ff0000][B]If Len(Range("A1").Value) > 0 Then[/B][/COLOR]
    MsgBox "You have data on the active worksheet... this code can only be run " & _
           "when the active sheet is empty!", vbCritical, "Worksheet Not Empty"
    Exit Sub
  End If
  .... < snip > ....
End Sub

works fine for the CSV data given by the OP.

The line of code I highlighted in red above is not a sufficient test... A1 (the intersection of headers) could quite easily be left blank on purpose. This code should be more bullet-proof. I also took the liberty to add an additional line of code to protect against the user clicking the Cancel button on the file selection dialog box.

Code:

Sub ImportFile()
  Dim R As Long, C As Long, FileNum As Long
  Dim TotalFile As String, PathAndFileName As String, Delim As String
  Dim Lines As Variant, Data As Variant, Fields As Variant
  [COLOR=#ff0000][B]If Application.CountA(Cells) Then[/B][/COLOR]
    MsgBox "You have data on the active worksheet... this code can only be run " & _
           "when the active sheet is empty!", vbCritical, "Worksheet Not Empty"
    Exit Sub
  End If
  FileNum = FreeFile
  PathAndFileName = Application.GetOpenFilename("CSV Files(*.csv),*.csv,All Files (*.*),*.*", 1, "Open CSV File")
  Open PathAndFileName For Binary As #FileNum
    [COLOR=#0000ff][B]If PathAndFileName = False Then Exit Sub[/B][/COLOR]
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  Lines = Split(TotalFile, vbNewLine)
  ReDim Data(1 To UBound(Lines) + 1, 1 To 20)
  If InStr(TotalFile, vbTab) Then
    Delim = vbTab
  Else
    Delim = ","
  End If
  For R = 0 To UBound(Lines)
    Fields = Split(Lines(R), Delim)
    For C = 0 To UBound(Fields)
      Data(R + 1, C + 1) = Fields(C)
    Next
  Next
  Range("A1").Resize(UBound(Data), UBound(Data, 2)) = Data
End Sub

DocAElstein said:
It also gives sensible results for the Tab delimited file from the Op, (although they may not be the exact results he wants as some columns are somewhat offset in the final Excel table).

I am not sure they are really incorrect offsets... if the file contains a double tab character, I would assume whatever program was used to create the file did so on purpose.

DocAElstein · Sep 3, 2014

Hi Rick,

Rick Rothstein said:
…….could have sworn I tested for that, but obviously I did not. Than……..

….. many thanks for replying and clearing that up. It is very helpful because when one is learning one can easily get confused.

Rick Rothstein said:
……The line of code I highlighted in red above is not a sufficient test... A1 (the intersection of headers) could quite easily be left blank on purpose. This code should be more bullet-proof. ……...

. The new condition line If Application.CountA(Cells) Then works very well, thanks.

...................

Rick Rothstein said:
……. I also took the liberty to add an additional line of code to protect against the user clicking the Cancel button on the file selection dialog box……..

. I also have that in mine as well as asking for the separator / delimiter. I am often a bit unsure how user friendly to make an answer to an OP. Sometimes it is extremely useful to be given a full working solution especially when one is working under time pressure. On the other hand I learn the most when I struggle and persevere to understand how, why it works, modify it for my needs, “ruin it with ‘Green comment graffiti … OR to try to find out why not if it does not work……….
……….Please correct me if I am wrong, but your latest code also does not work..

. If a valid file name is given, then the program crashes at this point

Code:

If PathAndFileName = False Then Exit Sub

. I expect because you have dimensioned PathAndFileName as a string. (So it does not except the False????). Replacing PathAndFileName As String with PathAndFileName As Variant seems to work.

. Your final working File with minor correction shown in Red

Code:

Sub ImportFile2()
  Dim R As Long, C As Long, FileNum As Long
  Dim TotalFile As String, PathAndFileName As[COLOR=#ff0000] Variant[/COLOR], Delim As String
  Dim Lines As Variant, Data As Variant, Fields As Variant
  If Application.CountA(Cells) Then
    MsgBox "You have data on the active worksheet... this code can only be run " & _
           "when the active sheet is empty!", vbCritical, "Worksheet Not Empty"
    Exit Sub
  End If
  FileNum = FreeFile
  PathAndFileName = Application.GetOpenFilename("CSV Files(*.csv),*.csv,All Files (*.*),*.*", 1, "Open CSV File")
  Open PathAndFileName For Binary As #FileNum
    If PathAndFileName = False Then Exit Sub
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  Lines = Split(TotalFile, vbNewLine)
  ReDim Data(1 To UBound(Lines) + 1, 1 To 20)
  If InStr(TotalFile, vbTab) Then
    Delim = vbTab
  Else
    Delim = ","
  End If
  For R = 0 To UBound(Lines)
    Fields = Split(Lines(R), Delim)
    For C = 0 To UBound(Fields)
      Data(R + 1, C + 1) = Fields(C)
    Next
  Next
  Range("A1").Resize(UBound(Data), UBound(Data, 2)) = Data
End Sub

……………………………

DocAElstein said:
……….. gives sensible results for the Tab delimited file from the Op, (although they may not be the exact results he wants as some columns are somewhat offset in the final Excel table).

Alan Elston

Rick Rothstein said:
……..not sure they are really incorrect offsets... if the file contains a double tab character, I would assume whatever program was used to create the file did so on purpose.

….. I am always unsure with spaces and Tabs as delimiters . I prefer to use something I can clearly see. I have the additional problem in Germany that a comer is taken as a Decimal Point! So a semi-colon ; or | is my favorite

Alan.

DocAElstein · Sep 3, 2014

Hi apo…

apo said:
…..If you have a heap of rows.. probably populating an array and writing that array to the sheet at the end will be faster...

Something like: (used on your sample comma separated data form above)........

Wow. Super Code. Works on csv ( .txt ) files, like that given from the OP.
(My Homework tonight: Figure out how it works!)
Alan.

apo · Sep 3, 2014

Hi DocAElstein,

(My Homework tonight: Figure out how it works!)

Step through the code (F8) and make sur eyou have the Locals WIndow open.. that will help you understand how, first the s array and then the y array are being populated..

Rick Rothstein · Sep 3, 2014

DocAElstein said:
Hi Rick,

……….Please correct me if I am wrong, but your latest code also does not work..

. If a valid file name is given, then the program crashes at this point

Code:

If PathAndFileName = False Then Exit Sub

. I expect because you have dimensioned PathAndFileName as a string. (So it does not except the False????). Replacing PathAndFileName As String with PathAndFileName As Variant seems to work.

Wow, I am beginning to wonder if I got anything right on that code!

You are correct (all I can do is blame my lapses on bad testing)... thanks for catching that.

DocAElstein · Sep 3, 2014

apo said:
Hi DocAElstein,

Step through the code (F8) and make sur eyou have the Locals WIndow open.. that will help you understand how, first the s array and then the y array are being populated..

..Thanks.. F8 I use frequently, .. the Locals WIndow I should certainly get into, - I have probably wasted a lot time Debuging.Printing like mad, when I think in the Locals WIndow it can be set up to show me continually as variables and arrays are filled. I must make the effort to do that BEFORE I do my Homework. Good tip / reminder on that one,
Alan

VBA - text import puts contents all in one cell, need comma delimit instead

Sayre

Board Regular

apo

Well-known Member

Excel Facts

DocAElstein

Banned user

Rick Rothstein

MrExcel MVP

DocAElstein

Banned user

Rick Rothstein

MrExcel MVP

DocAElstein

Banned user

DocAElstein

Banned user

apo

Well-known Member

Rick Rothstein

MrExcel MVP

DocAElstein

Banned user

Similar threads

Forum statistics

Share this page

VBA - text import puts contents all in one cell, need comma delimit instead

Board Regular

Well-known Member

Excel Facts

Banned user

MrExcel MVP

Banned user

MrExcel MVP

Banned user

Banned user

Well-known Member

MrExcel MVP

Banned user

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock