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

There is no problem to import this file to Excel 2010. So why to bother with old versions?

The solution is: Upgrade Excel.

On that you are right. But where I work (company) they haven´t done the upgrade. So I still have to live with 2003.

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...

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

Select allOpen 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

Select allOpen in new window

Edit: Sorry for the apparently delayed response.

Regards,
Zack Barresse

Hi Zack,

I´m still hooked on Excel 2003.

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

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

Select allOpen in new window

HTH

Zack

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

Select allOpen in new window

Excellent job, byundt! I really appreciate it. Thank you very much.