how do I import a CSV file with more than 65536 rows

I need to import a csv file that has more than 65536 rows of data and 20
columns, is there a way of setting up a vba macro so that once the 65536 has
been reached, the continuation moves onto the next sheet?

Steve,

You can do just about anything you want in Excel if you are good at VBA
and understand the Excel Object Model. In this case you would want to
code a routine that would open the text file, read 65536 rows, placing
each row in the appropriate row in a worksheet. After that, and for
each group of 65K rows, repeat the process on a new workseet. The
skill set to do this requires a good understanding of the Excel Object
model and VBA coding skills.

An easier way to address the issue, assuming it meets your
requirements, is to import your text file into MS Access and work with
it as a table. I dont believe tables in MS Access have any practical
limit (not that I've reached anyway). On the surface what you are
trying to do sounds more like a database application.

Good Luck!!


Steve wrote:
> I need to import a csv file that has more than 65536 rows of data and 20
> columns, is there a way of setting up a vba macro so that once the 65536 has
> been reached, the continuation moves onto the next sheet?

Grüezi

Steve schrieb am 14.07.2006

> I need to import a csv file that has more than 65536 rows of data and 20
> columns, is there a way of setting up a vba macro so that once the 65536 has
> been reached, the continuation moves onto the next sheet?

I once worte the following Code for this issue - it even splits the datas
to columns when you define the separator in the second part of the code.
The comments are in German, bout it should easy to change them:

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

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

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

On Error GoTo ErrorHandler
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 = " Einlesen Blatt " & intSheet & " / 0 %"

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
If (lngRow * 100 / lngRows) Mod 10 = 0 Then
Application.StatusBar = " Einlesen Blatt " & intSheet & _
" / " & Int(lngRow * 100 / lngRows) & " %"
End If
Else
Application.StatusBar = " Schreibe Daten in Blatt " & intSheet
ActiveSheet.Range("A1:A" & lngRows) = strValues
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)

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

' Beginn der Aufteilung in Spalten
Dim strDelimiter As String
Do
strDelimiter = Application.InputBox("1 ==> Tabulator " & Chr(13) & _
"2 ==> Semikolon" & Chr(13) & _
"3 ==> Komma" & Chr(13) & _
"4 ==> Leerzeichen" & Chr(13) & _
"5 ==> Andere" & Chr(13) & _
"Trennzeichen wählen", "1", Type:=1)
Loop Until CInt(strDelimiter) >= 0 And CInt(strDelimiter) <= 5

If strDelimiter = 5 Then
Dim strDelimOther As String
strDelimOther = Application.InputBox("Bitte das verwendete" _
& "Trennzeichen eingeben" & Chr(13) & _
"00 ==> Abbruch ", _
"Trennzeichen wählen", Type:=2)
If strDelimOther = "00" Then GoTo ErrorHandler
End If

intSheet = 0
For Each wsSheet In ActiveWorkbook.Worksheets
intSheet = intSheet + 1
Application.StatusBar = "Bearbeiten von Blatt " & intSheet
With wsSheet
.Range("A:A").TextToColumns Destination:=.Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=IIf(strDelimiter = "1", True, False), _
Semicolon:=IIf(strDelimiter = "2", True, False), _
Comma:=IIf(strDelimiter = "3", True, False), _
Space:=IIf(strDelimiter = "4", True, False), _
Other:=IIf(strDelimiter = "5", True, False), _
OtherChar:=IIf(strDelimiter = "5", strDelimOther, "")
End With
Next wsSheet
ErrorHandler:
Application.ScreenUpdating = True
Application.StatusBar = "Fertig"
End Sub


Mit freundlichen Grüssen
Thomas Ramel

--
- MVP für Microsoft-Excel -
[Win XP Pro SP-2 / xl2000 SP-3]
Microsoft Excel - Die ExpertenTipps:
(http://tinyurl.com/9ov3l und http://tinyurl.com/cmned)

Thanks Thomas,

My German is not too great and I am having trouble translating some of the
phrases in the code itself (not comments) and the google translator is not
really helping would you be able to have another look at the code. Problems
so far have been with the phrases: Bitte das verwendete, Trennzeichen
eingeben and Trennzeichen wählen.

Thanks again
Steve

"Thomas Ramel" wrote:

> Grüezi
>
> Steve schrieb am 14.07.2006
>
> > I need to import a csv file that has more than 65536 rows of data and 20
> > columns, is there a way of setting up a vba macro so that once the 65536 has
> > been reached, the continuation moves onto the next sheet?
>
> I once worte the following Code for this issue - it even splits the datas
> to columns when you define the separator in the second part of the code.
> The comments are in German, bout it should easy to change them:
>
> 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
>
> Filename = Application.GetOpenFilename("Textdateien " & _
> "(*.txt; *.csv;*.asc),*.txt; *.csv; *.asc")
>
> If Filename = "" Or Filename = "Falsch" Then Exit Sub
> FileNum = FreeFile()
>
> On Error GoTo ErrorHandler
> 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 = " Einlesen Blatt " & intSheet & " / 0 %"
>
> 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
> If (lngRow * 100 / lngRows) Mod 10 = 0 Then
> Application.StatusBar = " Einlesen Blatt " & intSheet & _
> " / " & Int(lngRow * 100 / lngRows) & " %"
> End If
> Else
> Application.StatusBar = " Schreibe Daten in Blatt " & intSheet
> ActiveSheet.Range("A1:A" & lngRows) = strValues
> ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
>
> ReDim strValues(lngRows, 1)
> lngRow = 1
> intSheet = intSheet + 1
> Application.StatusBar = "Einlesen Blatt " & intSheet
> End If
> Loop
> Close
> ActiveSheet.Range("A1:A" & lngRows) = strValues
>
> ' Beginn der Aufteilung in Spalten
> Dim strDelimiter As String
> Do
> strDelimiter = Application.InputBox("1 ==> Tabulator " & Chr(13) & _
> "2 ==> Semikolon" & Chr(13) & _
> "3 ==> Komma" & Chr(13) & _
> "4 ==> Leerzeichen" & Chr(13) & _
> "5 ==> Andere" & Chr(13) & _
> "Trennzeichen wählen", "1", Type:=1)
> Loop Until CInt(strDelimiter) >= 0 And CInt(strDelimiter) <= 5
>
> If strDelimiter = 5 Then
> Dim strDelimOther As String
> strDelimOther = Application.InputBox("Bitte das verwendete" _
> & "Trennzeichen eingeben" & Chr(13) & _
> "00 ==> Abbruch ", _
> "Trennzeichen wählen", Type:=2)
> If strDelimOther = "00" Then GoTo ErrorHandler
> End If
>
> intSheet = 0
> For Each wsSheet In ActiveWorkbook.Worksheets
> intSheet = intSheet + 1
> Application.StatusBar = "Bearbeiten von Blatt " & intSheet
> With wsSheet
> .Range("A:A").TextToColumns Destination:=.Range("A1"), _
> DataType:=xlDelimited, _
> TextQualifier:=xlDoubleQuote, _
> ConsecutiveDelimiter:=False, _
> Tab:=IIf(strDelimiter = "1", True, False), _
> Semicolon:=IIf(strDelimiter = "2", True, False), _
> Comma:=IIf(strDelimiter = "3", True, False), _
> Space:=IIf(strDelimiter = "4", True, False), _
> Other:=IIf(strDelimiter = "5", True, False), _
> OtherChar:=IIf(strDelimiter = "5", strDelimOther, "")
> End With
> Next wsSheet
> ErrorHandler:
> Application.ScreenUpdating = True
> Application.StatusBar = "Fertig"
> End Sub
>
>
> Mit freundlichen Grüssen
> Thomas Ramel
>
> --
> - MVP für Microsoft-Excel -
> [Win XP Pro SP-2 / xl2000 SP-3]
> Microsoft Excel - Die ExpertenTipps:
> (http://tinyurl.com/9ov3l und http://tinyurl.com/cmned)
>

If you search this newsgroup, you will find links to Microsofts site where
they have posted a macro to do this, but here is a modified version of the
same thing. I split the data as it comes into the workbook (using %% as
the delimiter-change as needed) instead of using TextToColumns at the end as
MS's macro does. For me, it sped things up 66%. Also, this one puts 50000
lines to a sheet -change as needed.

Option Explicit

Sub Import()
Const lngLastRow As Long = 50000
Const strDelimiter As String = "%%"
Dim objDestWkBk As Workbook
Dim objDestWkSht As Worksheet
Dim varResult As Variant
Dim varStartTime As Variant
Dim varEndTime As Variant
Dim dblCounter As Double
Dim lngFNumber As Long
Dim lngCounter As Long
Dim i As Long
Dim strResult As String
Dim strFName As String

On Error GoTo CleanUp
Application.ScreenUpdating = False

'Initialize variables
strFName = CStr(Application.GetOpenFilename)
If strFName = "" Or strFName = "False" Then End
lngFNumber = FreeFile()
dblCounter = 1
lngCounter = 1

'Open File
Open strFName For Input As #lngFNumber
varStartTime = Time

'Create new workbook
Set objDestWkBk = Workbooks.Add(template:=xlWorksheet)
Set objDestWkSht = objDestWkBk.Worksheets(1)

'Import the File
Do While Seek(lngFNumber) <= LOF(lngFNumber)
Application.StatusBar = "Importing Row " & _
Format(dblCounter, "#,###") & ": " & _
Format(Seek(lngFNumber), "#,###") & " / " & _
Format(LOF(lngFNumber), "#,###") & " bytes"
Line Input #lngFNumber, strResult
If Left(strResult, 1) = "=" Then _
strResult = "'" & strResult
varResult = Split(strResult, strDelimiter, -1, vbTextCompare)

For i = LBound(varResult) To UBound(varResult)
objDestWkSht.Cells(lngCounter, _
i + 1).Value = varResult(i)
Next i

'Increment counter variables
dblCounter = dblCounter + 1
If lngCounter = lngLastRow Then
lngCounter = 1
With objDestWkBk
Set objDestWkSht = .Worksheets.Add
objDestWkSht.Move after:=.Sheets(.Sheets.Count)
End With
Else: lngCounter = lngCounter + 1
End If
Loop

CleanUp:
Close
Application.StatusBar = False
Application.ScreenUpdating = True
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & ": " & Err.Description
Else
varEndTime = Time
MsgBox "Start Time: " & varStartTime & Chr(10) & "End Time: " & varEndTime
End If
Exit Sub

End Sub

"Steve" wrote:

> I need to import a csv file that has more than 65536 rows of data and 20
> columns, is there a way of setting up a vba macro so that once the 65536 has
> been reached, the continuation moves onto the next sheet?

http://support.microsoft.com/?kbid=272729



"JMB" wrote:

> If you search this newsgroup, you will find links to Microsofts site where
> they have posted a macro to do this, but here is a modified version of the
> same thing. I split the data as it comes into the workbook (using %% as
> the delimiter-change as needed) instead of using TextToColumns at the end as
> MS's macro does. For me, it sped things up 66%. Also, this one puts 50000
> lines to a sheet -change as needed.
>
> Option Explicit
>
> Sub Import()
> Const lngLastRow As Long = 50000
> Const strDelimiter As String = "%%"
> Dim objDestWkBk As Workbook
> Dim objDestWkSht As Worksheet
> Dim varResult As Variant
> Dim varStartTime As Variant
> Dim varEndTime As Variant
> Dim dblCounter As Double
> Dim lngFNumber As Long
> Dim lngCounter As Long
> Dim i As Long
> Dim strResult As String
> Dim strFName As String
>
> On Error GoTo CleanUp
> Application.ScreenUpdating = False
>
> 'Initialize variables
> strFName = CStr(Application.GetOpenFilename)
> If strFName = "" Or strFName = "False" Then End
> lngFNumber = FreeFile()
> dblCounter = 1
> lngCounter = 1
>
> 'Open File
> Open strFName For Input As #lngFNumber
> varStartTime = Time
>
> 'Create new workbook
> Set objDestWkBk = Workbooks.Add(template:=xlWorksheet)
> Set objDestWkSht = objDestWkBk.Worksheets(1)
>
> 'Import the File
> Do While Seek(lngFNumber) <= LOF(lngFNumber)
> Application.StatusBar = "Importing Row " & _
> Format(dblCounter, "#,###") & ": " & _
> Format(Seek(lngFNumber), "#,###") & " / " & _
> Format(LOF(lngFNumber), "#,###") & " bytes"
> Line Input #lngFNumber, strResult
> If Left(strResult, 1) = "=" Then _
> strResult = "'" & strResult
> varResult = Split(strResult, strDelimiter, -1, vbTextCompare)
>
> For i = LBound(varResult) To UBound(varResult)
> objDestWkSht.Cells(lngCounter, _
> i + 1).Value = varResult(i)
> Next i
>
> 'Increment counter variables
> dblCounter = dblCounter + 1
> If lngCounter = lngLastRow Then
> lngCounter = 1
> With objDestWkBk
> Set objDestWkSht = .Worksheets.Add
> objDestWkSht.Move after:=.Sheets(.Sheets.Count)
> End With
> Else: lngCounter = lngCounter + 1
> End If
> Loop
>
> CleanUp:
> Close
> Application.StatusBar = False
> Application.ScreenUpdating = True
> If Err.Number <> 0 Then
> MsgBox "Error " & Err.Number & ": " & Err.Description
> Else
> varEndTime = Time
> MsgBox "Start Time: " & varStartTime & Chr(10) & "End Time: " & varEndTime
> End If
> Exit Sub
>
> End Sub
>
> "Steve" wrote:
>
> > I need to import a csv file that has more than 65536 rows of data and 20
> > columns, is there a way of setting up a vba macro so that once the 65536 has
> > been reached, the continuation moves onto the next sheet?

Grüezi Steve

Steve schrieb am 14.07.2006

> My German is not too great and I am having trouble translating some of the
> phrases in the code itself (not comments) and the google translator is not
> really helping would you be able to have another look at the code. Problems
> so far have been with the phrases: Bitte das verwendete, Trennzeichen
> eingeben and Trennzeichen wählen.

Ok I'll try it again:


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

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

If Filename = "" Or Filename = "False" Then Exit Sub
FileNum = FreeFile()

On Error GoTo ErrorHandler
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 = " Reading Sheet " & intSheet & " / 0 %"

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
If (lngRow * 100 / lngRows) Mod 10 = 0 Then
Application.StatusBar = " Reading Sheet " & intSheet & _
" / " & Int(lngRow * 100 / lngRows) & " %"
End If
Else
Application.StatusBar = " Writing data so Sheet " & intSheet
ActiveSheet.Range("A1:A" & lngRows) = strValues
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)

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

' Start to split in Columns
Dim strDelimiter As String
Do
strDelimiter = Application.InputBox("1 ==> Tab " & Chr(13) & _
"2 ==> Semicolon" & Chr(13) & _
"3 ==> Comma" & Chr(13) & _
"4 ==> Space" & Chr(13) & _
"5 ==> Others" & Chr(13) & _
"Choose Separator", "1", Type:=1)
Loop Until CInt(strDelimiter) >= 0 And CInt(strDelimiter) <= 5

If strDelimiter = 5 Then
Dim strDelimOther As String
strDelimOther = Application.InputBox("Please type in the" _
& "Separation -Chraacter" & Chr(13) & _
"00 ==> Cancel ", _
"Choose Separtor", Type:=2)
If strDelimOther = "00" Then GoTo ErrorHandler
End If

intSheet = 0
For Each wsSheet In ActiveWorkbook.Worksheets
intSheet = intSheet + 1
Application.StatusBar = "Working on Sheet " & intSheet
With wsSheet
.Range("A:A").TextToColumns Destination:=.Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=IIf(strDelimiter = "1", True, False), _
Semicolon:=IIf(strDelimiter = "2", True, False), _
Comma:=IIf(strDelimiter = "3", True, False), _
Space:=IIf(strDelimiter = "4", True, False), _
Other:=IIf(strDelimiter = "5", True, False), _
OtherChar:=IIf(strDelimiter = "5", strDelimOther, "")
End With
Next wsSheet
ErrorHandler:
Application.ScreenUpdating = True
Application.StatusBar = "Finished"
End Sub


Mit freundlichen Grüssen
Thomas Ramel

--
- MVP für Microsoft-Excel -
[Win XP Pro SP-2 / xl2000 SP-3]
Microsoft Excel - Die ExpertenTipps:
(http://tinyurl.com/9ov3l und http://tinyurl.com/cmned)

Thanks Thomas

"Thomas Ramel" wrote:

> Grüezi Steve
>
> Steve schrieb am 14.07.2006
>
> > My German is not too great and I am having trouble translating some of the
> > phrases in the code itself (not comments) and the google translator is not
> > really helping would you be able to have another look at the code. Problems
> > so far have been with the phrases: Bitte das verwendete, Trennzeichen
> > eingeben and Trennzeichen wählen.
>
> Ok I'll try it again:
>
>
> 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
>
> Filename = Application.GetOpenFilename("Textdateien " & _
> "(*.txt; *.csv;*.asc),*.txt; *.csv; *.asc")
>
> If Filename = "" Or Filename = "False" Then Exit Sub
> FileNum = FreeFile()
>
> On Error GoTo ErrorHandler
> 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 = " Reading Sheet " & intSheet & " / 0 %"
>
> 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
> If (lngRow * 100 / lngRows) Mod 10 = 0 Then
> Application.StatusBar = " Reading Sheet " & intSheet & _
> " / " & Int(lngRow * 100 / lngRows) & " %"
> End If
> Else
> Application.StatusBar = " Writing data so Sheet " & intSheet
> ActiveSheet.Range("A1:A" & lngRows) = strValues
> ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
>
> ReDim strValues(lngRows, 1)
> lngRow = 1
> intSheet = intSheet + 1
> Application.StatusBar = "Reading Sheet " & intSheet
> End If
> Loop
> Close
> ActiveSheet.Range("A1:A" & lngRows) = strValues
>
> ' Start to split in Columns
> Dim strDelimiter As String
> Do
> strDelimiter = Application.InputBox("1 ==> Tab " & Chr(13) & _
> "2 ==> Semicolon" & Chr(13) & _
> "3 ==> Comma" & Chr(13) & _
> "4 ==> Space" & Chr(13) & _
> "5 ==> Others" & Chr(13) & _
> "Choose Separator", "1", Type:=1)
> Loop Until CInt(strDelimiter) >= 0 And CInt(strDelimiter) <= 5
>
> If strDelimiter = 5 Then
> Dim strDelimOther As String
> strDelimOther = Application.InputBox("Please type in the" _
> & "Separation -Chraacter" & Chr(13) & _
> "00 ==> Cancel ", _
> "Choose Separtor", Type:=2)
> If strDelimOther = "00" Then GoTo ErrorHandler
> End If
>
> intSheet = 0
> For Each wsSheet In ActiveWorkbook.Worksheets
> intSheet = intSheet + 1
> Application.StatusBar = "Working on Sheet " & intSheet
> With wsSheet
> .Range("A:A").TextToColumns Destination:=.Range("A1"), _
> DataType:=xlDelimited, _
> TextQualifier:=xlDoubleQuote, _
> ConsecutiveDelimiter:=False, _
> Tab:=IIf(strDelimiter = "1", True, False), _
> Semicolon:=IIf(strDelimiter = "2", True, False), _
> Comma:=IIf(strDelimiter = "3", True, False), _
> Space:=IIf(strDelimiter = "4", True, False), _
> Other:=IIf(strDelimiter = "5", True, False), _
> OtherChar:=IIf(strDelimiter = "5", strDelimOther, "")
> End With
> Next wsSheet
> ErrorHandler:
> Application.ScreenUpdating = True
> Application.StatusBar = "Finished"
> End Sub
>
>
> Mit freundlichen Grüssen
> Thomas Ramel
>
> --
> - MVP für Microsoft-Excel -
> [Win XP Pro SP-2 / xl2000 SP-3]
> Microsoft Excel - Die ExpertenTipps:
> (http://tinyurl.com/9ov3l und http://tinyurl.com/cmned)
>

Grüezi Steve

Steve schrieb am 14.07.2006

> Thanks Thomas

You're welcome, Steve. :-)


Mit freundlichen Grüssen
Thomas Ramel

--
- MVP für Microsoft-Excel -
[Win XP Pro SP-2 / xl2000 SP-3]
Microsoft Excel - Die ExpertenTipps:
(http://tinyurl.com/9ov3l und http://tinyurl.com/cmned)

Thanks JMB, That really hit the spot

Steve

"JMB" wrote:

> If you search this newsgroup, you will find links to Microsofts site where
> they have posted a macro to do this, but here is a modified version of the
> same thing. I split the data as it comes into the workbook (using %% as
> the delimiter-change as needed) instead of using TextToColumns at the end as
> MS's macro does. For me, it sped things up 66%. Also, this one puts 50000
> lines to a sheet -change as needed.
>
> Option Explicit
>
> Sub Import()
> Const lngLastRow As Long = 50000
> Const strDelimiter As String = "%%"
> Dim objDestWkBk As Workbook
> Dim objDestWkSht As Worksheet
> Dim varResult As Variant
> Dim varStartTime As Variant
> Dim varEndTime As Variant
> Dim dblCounter As Double
> Dim lngFNumber As Long
> Dim lngCounter As Long
> Dim i As Long
> Dim strResult As String
> Dim strFName As String
>
> On Error GoTo CleanUp
> Application.ScreenUpdating = False
>
> 'Initialize variables
> strFName = CStr(Application.GetOpenFilename)
> If strFName = "" Or strFName = "False" Then End
> lngFNumber = FreeFile()
> dblCounter = 1
> lngCounter = 1
>
> 'Open File
> Open strFName For Input As #lngFNumber
> varStartTime = Time
>
> 'Create new workbook
> Set objDestWkBk = Workbooks.Add(template:=xlWorksheet)
> Set objDestWkSht = objDestWkBk.Worksheets(1)
>
> 'Import the File
> Do While Seek(lngFNumber) <= LOF(lngFNumber)
> Application.StatusBar = "Importing Row " & _
> Format(dblCounter, "#,###") & ": " & _
> Format(Seek(lngFNumber), "#,###") & " / " & _
> Format(LOF(lngFNumber), "#,###") & " bytes"
> Line Input #lngFNumber, strResult
> If Left(strResult, 1) = "=" Then _
> strResult = "'" & strResult
> varResult = Split(strResult, strDelimiter, -1, vbTextCompare)
>
> For i = LBound(varResult) To UBound(varResult)
> objDestWkSht.Cells(lngCounter, _
> i + 1).Value = varResult(i)
> Next i
>
> 'Increment counter variables
> dblCounter = dblCounter + 1
> If lngCounter = lngLastRow Then
> lngCounter = 1
> With objDestWkBk
> Set objDestWkSht = .Worksheets.Add
> objDestWkSht.Move after:=.Sheets(.Sheets.Count)
> End With
> Else: lngCounter = lngCounter + 1
> End If
> Loop
>
> CleanUp:
> Close
> Application.StatusBar = False
> Application.ScreenUpdating = True
> If Err.Number <> 0 Then
> MsgBox "Error " & Err.Number & ": " & Err.Description
> Else
> varEndTime = Time
> MsgBox "Start Time: " & varStartTime & Chr(10) & "End Time: " & varEndTime
> End If
> Exit Sub
>
> End Sub
>
> "Steve" wrote:
>
> > I need to import a csv file that has more than 65536 rows of data and 20
> > columns, is there a way of setting up a vba macro so that once the 65536 has
> > been reached, the continuation moves onto the next sheet?