Solved

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

Posted on 2014-01-22
10
594 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 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
Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

 
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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

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…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
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…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

839 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