Solved

Need to import data from a file with more than 256 columns o data.

Posted on 2014-01-22
10
551 Views
Last Modified: 2014-01-23
Hi,

I have a text file (see attachment) that supposedly was created as ANSI text. Data file has around 350 columns of data, so I thought the solution worked out by Microsoft support (reference http://support.microsoft.com/kb/272729) was going to work. Then I copied the VBA code suggested by Microsoft into a blank Excel book and started the macro.

It seems the macro opens the file OK, but after a while an error dialog pops up: "An error occurred in the code", and a string of data corresponding to column headers has been copied into row 1 of the Excel.


I kindly ask for your help.
22-ene-14.txt
0
Comment
Question by:capterdi
  • 4
  • 2
  • 2
  • +1
10 Comments
 
LVL 41

Expert Comment

by:pcelba
ID: 39801453
There is no problem to import this file to Excel 2010. So why to bother with old versions?

The solution is: Upgrade Excel.
0
 

Author Comment

by:capterdi
ID: 39801463
On that you are right. But where I work (company) they haven´t done the upgrade. So I still have to live with 2003.
0
 
LVL 41

Expert Comment

by:pcelba
ID: 39801488
You should explain them: Either you will buy one copy of newer Excel or I'll spent hours of tracing the obsolete VBA code used for this conversion...

They should calculate a bit... Or you may wait if somebody can fix the VBA code for you here...
0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 39801508
Hi there,

What version of Excel are you using? There hasn't been a 256 column limit in 10 years. If you're using Excel 2007 or later there is no need for this whatsoever. (Besides some other things in that piece of code which aren't needed.)

To see where you're getting the error, comment out the On Error statement at the top by placing a single apostrophe in front of it...

    'On Error GoTo ErrorCheck

Open in new window


Personally I dislike having to use an inputbox to type in a files full path and name, and generally go for a file dialog picker. Here is an example...

    FileName = Application.GetOpenFilename("Text File Only (*.txt), *.txt")
    If FileName = "False" Then Exit Sub
    If Dir(FileName, vbNormal) = vbNullString Then Exit Sub

Open in new window


Edit: Sorry for the apparently delayed response.

Regards,
Zack Barresse
0
 

Author Comment

by:capterdi
ID: 39801648
Hi Zack,

I´m still hooked on Excel 2003.
0
Get up to 2TB FREE CLOUD per backup license!

An exclusive Black Friday offer just for Expert Exchange audience! Buy any of our top-rated backup solutions & get up to 2TB free cloud per system! Perform local & cloud backup in the same step, and restore instantly—anytime, anywhere. Grab this deal now before it disappears!

 

Author Comment

by:capterdi
ID: 39801678
Ok. I did the commenting out. Tested again. Now I get an out of memory error. Execution stops here (see picture attached).
Out-of-memory.jpg
0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 39801950
You're getting the error because some data lines are preceded with a minus sign, which chokes Excel. If you precede all values (as text) with a single apostrophe it will work just fine (except the second TextToColumns, which doesn't have anything to work on). Although this is only from the code on the linked sheet, and I doubt it matches what you have exactly.

In the end there's no need to select anything. It would help if we saw your code though.

What is the delimiter of the file anyway? It looks like a Tab, but you need to clarify.

Because I'm not sure of the specifics, I don't know if this is what you want or not...

Const Delim                     As String = vbTab    '","
Const DelimTemp                 As String = "|"

Sub LargeDatabaseImport()

    Dim Wks                     As Worksheet
    Dim NewWks                  As Worksheet
    Dim TextFile                As Object
    Dim FSO                     As Object
    Dim iCol                    As Long
    Dim iCell                   As Long
    Dim iRow                    As Long
    Dim FileName                As String
    Dim Text                    As String
    Dim TextPart                As String
    Dim FilePath                As String
    Dim LineText                As Variant
    Dim FieldData()             As Variant

    Set FSO = CreateObject("Scripting.FileSystemObject")
    FileName = Application.GetOpenFilename("Text File Only (*.txt), *.txt")
    DoEvents: DoEvents: DoEvents
    If FileName = "False" Then Exit Sub
    If Dir(FileName, vbNormal) = vbNullString Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set TextFile = FSO.OpenTextFile(FileName, 1, False)
    Set Wks = Worksheets("Sheet1")
    Wks.Cells.Clear
    iRow = 1
    Do While Not TextFile.AtendOfStream
        Text = TextFile.ReadLine
        LineText = Split(Text, Delim)
        Application.StatusBar = "Working on line " & iRow
        For iCol = 0 To UBound(LineText) - 1 Step Wks.Columns.Count
            ReDim FieldData(Wks.Columns.Count - 1)
            TextPart = vbNullString
            For iCell = 0 To Wks.Columns.Count - 1
                If iCol + iCell < UBound(LineText) Then
                    Wks.Cells(iRow, iCol / Wks.Columns.Count + 1).Value = IIf(iCol = 0, "'", "") & Wks.Cells(iRow, iCol / Wks.Columns.Count + 1).Value & LineText(iCol + iCell) & Delim
                Else
                    Exit For
                End If
            Next iCell
            If Right(Wks.Cells(iRow, iCol / Wks.Columns.Count + 1).Value, Len(Delim)) = Delim Then
                TextPart = Wks.Cells(iRow, iCol / Wks.Columns.Count + 1).Value
                Wks.Cells(iRow, iCol / Wks.Columns.Count + 1).Value = "'" & Left(TextPart, Len(TextPart) - Len(Delim))
            End If
        Next iCol
        iRow = iRow + 1
    Loop

    TextFile.Close

    '**************************************************************************************************************
    
    For iCol = Wks.Cells(1, Wks.Columns.Count).End(xlToLeft).Column To 2 Step -1
        Set NewWks = Nothing
        Set NewWks = Worksheets.Add(After:=Wks)
        Wks.Columns(iCol).EntireColumn.Cut NewWks.Columns(1).EntireColumn
        NewWks.Columns(1).EntireColumn.TextToColumns Destination:=NewWks.Range("A1"), DataType:=xlDelimited, _
                                                     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                                     Semicolon:=False, Comma:=True, Space:=False, Other:=False
    Next iCol
    Wks.Columns(1).EntireColumn.TextToColumns Destination:=Wks.Range("A1"), DataType:=xlDelimited, _
                                              TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                              Semicolon:=False, Comma:=True, Space:=False, Other:=False
    Application.StatusBar = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True

ExitRoutine:

    Exit Sub

ErrorCheck:

    MsgBox "An error occured in the code."
    GoTo ExitRoutine

End Sub

Open in new window


HTH

Zack
0
 
LVL 80

Expert Comment

by:byundt
ID: 39802056
The instructions for the Microsoft code say that it is intended for use on .csv file format. You have a tab delimited file.

I converted the file from .txt to .csv (by using a text editor to replace tabs with commas), and the code ran without error in Excel 2003.

Note how I inserted the file browser code that Zack was suggesting.
Sub LargeDatabaseImport()

    'In the event of an error, make sure the application is reset to
    'normal.
    On Error GoTo ErrorCheck

    'Dimension Variables
    Dim ResultStr As String
    Dim FileName As String
    Dim FileNum As Integer
    Dim Counter As Double
    Dim CommaCount As Integer
    Dim WorkResult As String

    'Ask for the name of the file.
    FileName = Application.GetOpenFilename("Text File Only (*.csv), *.csv")
    If FileName = "False" Then Exit Sub
    If Dir(FileName, vbNormal) = vbNullString Then Exit Sub
    
    'Turn off ScreenUpdating and Events so that users can't see what is
    'happening and can't affect the code while it is running.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    'Get next available file handle number.
    FileNum = FreeFile()
    
    'Open text file for input.
    Open FileName For Input As #FileNum
    
    'Turn ScreenUpdating off.
    Application.ScreenUpdating = False

    'Set the counter to 1.
    Counter = 1

    'Place the data in the first row of the column.
    Range("A1").Activate

    'Loop until the end of file is reached.
    Do While Seek(FileNum) <= LOF(FileNum)

        'Show row number being imported on status bar.
        Application.StatusBar = "Importing Row " & _
                Counter & " of text file " & FileName

        'Store one line of text from file to variable.
        Line Input #FileNum, ResultStr

        'Initialize the CommaCount variable to zero.
        CommaCount = 0
        
        'Store the entire string into a second, temporary string.
        WorkResult = ResultStr

        'Parse through the first line of data and separate out records
        '257 to 510.
        While CommaCount < 255

            WorkResult = Right(WorkResult, Len(WorkResult) - InStr(1, WorkResult, ","))
            CommaCount = CommaCount + 1

        Wend

        'Parse out any leading spaces.
        If Left(WorkResult, 1) = " " Then WorkResult = Right(WorkResult, Len(WorkResult) - 1)

        'Ensure that any records that contain an "=" sign are
        'brought in as text, and set the value of the current
        'cell to the first 256 records.
        If Left(WorkResult, 1) = "=" Then
            ActiveCell.Value = "'" & Left(ResultStr, Len(ResultStr) - Len(WorkResult))
        Else
            ActiveCell.Value = Left(ResultStr, Len(ResultStr) - Len(WorkResult))
        End If

        'Ensure that any records that contain an "=" sign are
        'brought in as text,and set the value of the next cell
        'to the last 256 records.
        If Left(WorkResult, 1) = "=" Then
            ActiveCell.Offset(0, 1).Value = "'" & WorkResult
        Else
            ActiveCell.Offset(0, 1).Value = WorkResult
        End If

        'Move down one cell.
        ActiveCell.Offset(1, 0).Activate

        'Increment the Counter by 1.
        Counter = Counter + 1

        'Start again at top of 'Do While' statement.
    Loop

    'Close the open text file.
    Close

    'Take records 257-510 and move them to sheet two.
    Columns("B:B").Select
    Selection.Cut
    Sheets("Sheet2").Select
    Columns("A:A").Select
    ActiveSheet.Paste

    'Run the text-to-columns wizard on both sheets.
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1))
    Sheets("Sheet1").Select
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1))

    'Reset the application to its normal operating environment.
    Application.StatusBar = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True

    Exit Sub

ErrorCheck:

    'Reset the application to its normal operating environment.
    Resume Next
    Application.StatusBar = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "An error occured in the code."

End Sub

Open in new window

0
 
LVL 80

Accepted Solution

by:
byundt earned 500 total points
ID: 39802078
I modified Microsoft's code so it would accept a TAB as a delimiter. The modified code runs on your .txt file as you posted it.
Sub LargeDatabaseImportTAB()

    'In the event of an error, make sure the application is reset to
    'normal.
    On Error GoTo ErrorCheck

    'Dimension Variables
    Dim ResultStr As String
    Dim FileName As String
    Dim FileNum As Integer
    Dim Counter As Double
    Dim CommaCount As Integer
    Dim WorkResult As String
    Dim Delimiter As String
    
    Delimiter = Chr(9)  'TAB character

    'Ask for the name of the file.
    FileName = Application.GetOpenFilename("Text File Only (*.txt), *.txt")
    If FileName = "False" Then Exit Sub
    If Dir(FileName, vbNormal) = vbNullString Then Exit Sub
    
    'Turn off ScreenUpdating and Events so that users can't see what is
    'happening and can't affect the code while it is running.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    'Get next available file handle number.
    FileNum = FreeFile()
    
    'Open text file for input.
    Open FileName For Input As #FileNum
    
    'Turn ScreenUpdating off.
    Application.ScreenUpdating = False

    'Set the counter to 1.
    Counter = 1

    'Place the data in the first row of the column.
    Range("A1").Activate

    'Loop until the end of file is reached.
    Do While Seek(FileNum) <= LOF(FileNum)

        'Show row number being imported on status bar.
        Application.StatusBar = "Importing Row " & _
                Counter & " of text file " & FileName

        'Store one line of text from file to variable.
        Line Input #FileNum, ResultStr

        'Initialize the CommaCount variable to zero.
        CommaCount = 0
        
        'Store the entire string into a second, temporary string.
        WorkResult = ResultStr

        'Parse through the first line of data and separate out records
        '257 to 510.
        While CommaCount < 255

            WorkResult = Right(WorkResult, Len(WorkResult) - InStr(1, WorkResult, Delimiter))
            CommaCount = CommaCount + 1

        Wend

        'Parse out any leading spaces.
        If Left(WorkResult, 1) = " " Then WorkResult = Right(WorkResult, Len(WorkResult) - 1)

        'Ensure that any records that contain an "=" sign are
        'brought in as text, and set the value of the current
        'cell to the first 256 records.
        If Left(WorkResult, 1) = "=" Then
            ActiveCell.Value = "'" & Left(ResultStr, Len(ResultStr) - Len(WorkResult))
        Else
            ActiveCell.Value = Left(ResultStr, Len(ResultStr) - Len(WorkResult))
        End If

        'Ensure that any records that contain an "=" sign are
        'brought in as text,and set the value of the next cell
        'to the last 256 records.
        If Left(WorkResult, 1) = "=" Then
            ActiveCell.Offset(0, 1).Value = "'" & WorkResult
        Else
            ActiveCell.Offset(0, 1).Value = WorkResult
        End If

        'Move down one cell.
        ActiveCell.Offset(1, 0).Activate

        'Increment the Counter by 1.
        Counter = Counter + 1

        'Start again at top of 'Do While' statement.
    Loop

    'Close the open text file.
    Close

    'Take records 257-510 and move them to sheet two.
    Columns("B:B").Select
    Selection.Cut
    Sheets(ActiveSheet.Index + 1).Select
    Columns("A:A").Select
    ActiveSheet.Paste

    'Run the text-to-columns wizard on both sheets.
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1))
    Sheets(ActiveSheet.Index - 1).Select
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1))

    'Reset the application to its normal operating environment.
    Application.StatusBar = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True

    Exit Sub

ErrorCheck:

    'Reset the application to its normal operating environment.
    Resume Next
    Application.StatusBar = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "An error occured in the code."

End Sub

Open in new window

0
 

Author Closing Comment

by:capterdi
ID: 39803414
Excellent job, byundt! I really appreciate it. Thank you very much.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

User Beware!  This is a rather permanent solution to removing your email from an exchange server.  The only way to truly go back is to have your exchange administrator restore your mailbox from backups.  This is usually the option of last resort.  A…
This collection of functions covers all the normal rounding methods of just about any numeric value.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now