slow reading a text file into excel

[larrydave]

Hello;

I have a macro that imports a large text file into excel; it puts the data
in every fourth column after column A (starting in A2) fills up); last week
it was running fairly fast - it took maybe 20-30 seconds to read over 70,000
lines. This week, it has slowed down considerably and I didn't make any code
changes. Tonight after letting it run for an hour, I calculate it will take
at least 7 hours to finish reading the file. The file size is 7547 KB as of
right now, but it is constantly growing. I am hoping a bright mind could look
at my code and see if there is something I could do to speed it up. At first
I thought it was my pc because it has been acting up, but I tested it on a
newer pc and have the same difficulty.

Just for info - I need to have the data in every fourth column as I then use
the text to columns function, filter by date in column a - if it meets a
certain criteria, I clear A and shift columns E through IR 4 columns to the
left. At this time, all this is done with other macros and formulas;
eventually I will combine into one, but I am working in pieces for my own
clarity.

Sub Auto_Open()
MsgBox "Hello"
Columns("a:ir").EntireColumn.Clear
Dim FileName As String
Dim ResultStr As String
Dim FileNum As Integer
Dim Counter As Double
FileName = Application.GetOpenFilename
Application.ScreenUpdating = False
If FileName = "False" Then End
FileNum = FreeFile()
Open FileName For Input As #FileNum
Sheet1.Cells(2, 1).Select
Counter = 1
ColCounter = 4

Do While Seek(FileNum) <= LOF(FileNum)
If EOF(FileNum) Then End
Application.StatusBar = "Reading Row " & Counter & " of text file " &
FileName
Line Input #FileNum, ResultStr

ActiveCell.Value = ResultStr
If ActiveCell.Row = 65536 Then
ColCounter = ColCounter + 1
Sheet1.Cells(2, ColCounter).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Counter = Counter + 1

Loop
Close
Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

I esc to end the macro, and hit the debugger. It stops at this line:
If ActiveCell.Row = 65536 Then

Almost everything in that macro I have found here in this community - thank
you; and thank you in advance for any ideas.

 

[ryguy7272]

Try this:
Public Sub DoTheImport()
Dim FName As Variant
Dim Sep As String

FName = Application.GetOpenFilename _
(filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*")
If FName = False Then
MsgBox "You didn't select a file"
Exit Sub
End If

Sep = InputBox("Enter a single delimiter character.", _
"Import Text File")
ImportTextFile CStr(FName), Sep

End Sub



Public Sub ImportTextFile(FName As String, Sep As String)

Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

Application.ScreenUpdating = False
'On Error GoTo EndMacro:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

Open FName For Input Access Read As #1

While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1

End Sub


You can also import multiple text files:
Sub Import_Multiple_Text_Files()

Dim F As Variant
Dim x As Integer

Const MyPath = "c:\temp\"

first = True

RowCount = 1
Do
If first = True Then
Filename = Dir(MyPath & "*.txt")
first = False
Else
Filename = Dir()
End If

If Filename <> "" Then

Open (MyPath & Filename) For Input Access Read As #1
Do Until EOF(1)
Line Input #1, qdata
If qdata <> "" Then
Cells(RowCount, 1) = qdata
RowCount = RowCount + 1
End If
Loop
Close #1
End If
Loop While Filename <> ""
End Sub

Regards,
Ryan---

 

[Jim Cone]

I've just cleaned up your existing code a little.
The important thing may be to run the code in a brand new
workbook each time you open the large text file...
'---
Sub Auto_Open()
MsgBox "Hello"
Columns("a:ir").EntireColumn.Clear
Dim FileName As String
Dim ResultStr As String
Dim FileNum As Integer
Dim Counter As Long
Dim ColCounter As Long
Dim N As Long

FileName = Application.GetOpenFilename
Application.ScreenUpdating = False
If FileName = "False" Then End
FileNum = FreeFile()
Open FileName For Input As #FileNum
Sheet1.Select
N = 2
Counter = 1
ColCounter = 1

Do While Seek(FileNum) <= LOF(FileNum)
If EOF(FileNum) Then End
Application.StatusBar = "Reading Row " & Counter & _
" of text file " & FileName
Line Input #FileNum, ResultStr

Cells(N, ColCounter).Value = ResultStr
If N >= 65535 Then
ColCounter = ColCounter + 4
N = 1
End If
N = N + 1
Counter = Counter + 1
Loop
Close
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
--
Jim Cone
Portland, Oregon USA



"larrydave"
wrote in message
Hello;
I have a macro that imports a large text file into excel; it puts the data
in every fourth column after column A (starting in A2) fills up); last week
it was running fairly fast - it took maybe 20-30 seconds to read over 70,000
lines. This week, it has slowed down considerably and I didn't make any code
changes. Tonight after letting it run for an hour, I calculate it will take
at least 7 hours to finish reading the file. The file size is 7547 KB as of
right now, but it is constantly growing. I am hoping a bright mind could look
at my code and see if there is something I could do to speed it up. At first
I thought it was my pc because it has been acting up, but I tested it on a
newer pc and have the same difficulty.

Just for info - I need to have the data in every fourth column as I then use
the text to columns function, filter by date in column a - if it meets a
certain criteria, I clear A and shift columns E through IR 4 columns to the
left. At this time, all this is done with other macros and formulas;
eventually I will combine into one, but I am working in pieces for my own
clarity.

Sub Auto_Open()
MsgBox "Hello"
Columns("a:ir").EntireColumn.Clear
Dim FileName As String
Dim ResultStr As String
Dim FileNum As Integer
Dim Counter As Double
FileName = Application.GetOpenFilename
Application.ScreenUpdating = False
If FileName = "False" Then End
FileNum = FreeFile()
Open FileName For Input As #FileNum
Sheet1.Cells(2, 1).Select
Counter = 1
ColCounter = 4

Do While Seek(FileNum) <= LOF(FileNum)
If EOF(FileNum) Then End
Application.StatusBar = "Reading Row " & Counter & " of text file " &
FileName
Line Input #FileNum, ResultStr

ActiveCell.Value = ResultStr
If ActiveCell.Row = 65536 Then
ColCounter = ColCounter + 1
Sheet1.Cells(2, ColCounter).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Counter = Counter + 1

Loop
Close
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

I esc to end the macro, and hit the debugger. It stops at this line:
If ActiveCell.Row = 65536 Then
Almost everything in that macro I have found here in this community - thank
you; and thank you in advance for any ideas.

 

[larrydave]

I used your code and opened it in a new workbook, but it is still just as
slow. The debugger stops at this line:

If N >= 65535 Then

Thank you for trying!

 

[larrydave]

I tried this one: after I input a delimiter, it stalled. The debugger stops
at this line:

Pos = NextPos + 1

Thanks for trying!

 

[Jim Cone]

It worked for me in xl2002.
I have to assume there are other issues involved?

Did you try the code provided by Peter T in your other post?
It is much faster.
--
Jim Cone
Portland, Oregon USA


"larrydave"
wrote in message
I used your code and opened it in a new workbook, but it is still just as
slow. The debugger stops at this line:

If N >= 65535 Then

Thank you for trying!