Solved

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

Posted on 2014-01-22
10
612 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
  • 2
  • +1
10 Comments
 
LVL 42

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 42

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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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
 

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 81

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 81

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

Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

739 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