opening a large text or csv file

[Srikanth Ganesan]

Hi,

I am trying to write a macro where I have to import a large text or CSV
file. The number of rows in the file is something like 805000 (number of
columns if just 2). Obviously excel cannot handle rows greater than
65536.
I want to open 1000 rows at a time and put it in the excel sheet, then
open another 1000 and so on. How can I do this ? Please help. If you
have a better way of doing this please let me know as well. Thanks

Srikanth

 

[Thomas Ramel]

Grüezi Srikanth

Srikanth Ganesan schrieb am 03.11.2004

I am trying to write a macro where I have to import a large text or CSV
file. The number of rows in the file is something like 805000 (number of
columns if just 2). Obviously excel cannot handle rows greater than
65536.

Try the following Macro I wrote for this - if you modify the part in the
end you are even able to separate your columns:
(Maybe you have to translate some Strings to English)

***********************************************************************
Option Explicit
Option Base 1

Sub LargeFileImport()

Dim FileName As String
Dim FileNum As Integer
Dim ResultStr As String

Dim wsSheet As Worksheet
Dim strValues() As String

Dim lngRows As Long
Dim lngRow As Long
Dim intSheet As Integer
Dim intCounter As Integer

FileName = Application.GetOpenFilename("Textdateien " & _
"(*.txt; *.csv),*.txt; *.csv")

If FileName = "" Or FileName = "Falsch" Then Exit Sub
FileNum = FreeFile()

Open FileName For Input As #FileNum
Application.ScreenUpdating = False
Workbooks.Add template:=xlWorksheet

lngRows = ActiveSheet.Rows.Count
lngRow = 1
intSheet = 1
ReDim strValues(lngRows, 1)

Application.StatusBar = "Blatt " & intSheet & " wird eingelesen"

Do While Seek(FileNum) <= LOF(FileNum)
Line Input #FileNum, ResultStr
If Left(ResultStr, 1) = "=" Then
strValues(lngRow, 1) = "'" & ResultStr
Else
strValues(lngRow, 1) = ResultStr
End If
If lngRow < lngRows Then
lngRow = lngRow + 1
Else
ActiveSheet.Range("A1:A" & lngRows) = strValues
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)

ReDim strValues(lngRows, 1)
lngRow = 1
intSheet = intSheet + 1
Application.StatusBar = "Blatt " & intSheet & " wird eingelesen"
End If
Loop
Close
ActiveSheet.Range("A1:A" & lngRows) = strValues

If MsgBox("Sollen die eingelesenen Daten auf Spalten verteilt werden?", _
vbYesNo, "Text in Spalten") = vbNo Then
Application.ScreenUpdating = True
Application.StatusBar = "Fertig"
Exit Sub
End If

intSheet = 0
For Each wsSheet In ActiveWorkbook.Worksheets
intSheet = intSheet + 1
Application.StatusBar = "Daten von Blatt " & intSheet _
& " werden bearbeitet"
With wsSheet
.Range("A:A").TextToColumns Destination:=.Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False
End With
Next wsSheet
Application.ScreenUpdating = True
Application.StatusBar = "Fertig"
End Sub
***********************************************************************

--
Regards

Thomas Ramel
- MVP for Microsoft-Excel -

[Win XP Pro SP-1 / xl2000 SP-3]

 

[clane]

when i have to use a file larger than what excel can handle I usaull
just open it with access first so then import to excel 65000 cells a
a time, while its not the most wieldy it does work

Cheer

 

[Dsuperc]

Sub LargeFileImport()

Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim Counter As Double
FileName = InputBox("Please enter the Text File's name, e.g.
S:\Revenue\Straus\BATCHOCCMUM121002.txt")
If FileName = "" Then End
FileNum = FreeFile()
Open FileName For Input As #FileNum
Application.ScreenUpdating = False
Workbooks.Add template:=xlWorksheet
Counter = 1
Do While Seek(FileNum) <= LOF(FileNum)
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
Line Input #FileNum, ResultStr
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If

If ActiveCell.row = 65536 Then
ActiveWorkbook.Sheets.Add
Else
ActiveCell.Offset(1, 0).Select
End If
Counter = Counter + 1
Loop
Close
Application.StatusBar = False

End Sub