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

S

Steve

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?
 
W

wardellcastles

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!!
 
T

Thomas Ramel

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
 
S

Steve

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 said:
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)
 
J

JMB

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
 
J

JMB

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



JMB said:
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
 
T

Thomas Ramel

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
 
S

Steve

Thanks Thomas

Thomas Ramel said:
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)
 
S

Steve

Thanks JMB, That really hit the spot

Steve

JMB said:
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top