[SOLVED] Parsing CSV is randomly slow

[schlagg]

i've write a code that import a csv file in an excel worksheet

the code works fine but, with the same csv file, the speed of the tests are sometimes very quick and other times very slow

here is my code :

Sub Import_CSV()
    Dim pcti As Single, pctj As Single, dept As Single
    
    pcti = Timer
    pctj = Timer
    dept = Timer
    
    'here i select my csv file
    FileToOpen = Application.GetOpenFilename("Fichier CSV (*.csv), *.csv", , "Sélectionner le fichier à importer ...", , False)
    If FileToOpen = False Then
        Exit Sub
    End If
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set Fichier = objFSO.OpenTextFile(FileToOpen, 1, True)
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(FileToOpen, 1, False)
    
    Application.ScreenUpdating = False
    
    i = 1
    Do Until Fichier.AtEndOfStream
        j = i - 1
        tab_line = Split(Fichier.ReadLine, ";")
    
        If i >= 2 Then
            Feuil1.Range("A" & j).Value = tab_line(0)
            Feuil1.Range("B" & j).Value = tab_line(1)
            Feuil1.Range("C" & j).Value = tab_line(2)
            Feuil1.Range("D" & j).Value = tab_line(3)
            Feuil1.Range("E" & j).Value = tab_line(4)
            Feuil1.Range("F" & j).Value = tab_line(5)
            Feuil1.Range("G" & j).Value = tab_line(6)
        End If

        i = i + 1
    Loop

    'here i clear the unwated cells
    j = i - 1
    Feuil1.Range("A" & G, "J65000").ClearContents
    
    Application.ScreenUpdating = True
    Unload u_progression
End Sub

my csv file is semicolon formated
and contains about 8000 lines
exemple :

Nbre;dtehre;Heures;Debits Sens 1;Données Reconstituées; Données (année - 1);ID
1;2009-03-05 00:00:00;00;0;49;49;38611
2;2009-03-05 01:00:00;01;0;20;20;38612
3;2009-03-05 02:00:00;02;0;28;28;38613
4;2009-03-05 03:00:00;03;0;15;15;38614
5;2009-03-05 04:00:00;04;0;7;7;38615
6;2009-03-05 05:00:00;05;0;7;7;38616
.....
.....

with the same file, sometimes it take 1 minute max, and sometimes about 20min
and it seems its very randomly (i tried to quit and execute excel, boot and reboot computer, etc ...) but never be able to find a cause

so maybe its something in the code, maybe is there something i ccan inprove

thanks to help
bye

[Siddharth Rout]

Welcome to the forums

Would something like this speed up your process?

FileToOpen = "C:\Mycsv.Csv"

Workbooks.OpenText Filename:= _
FileToOpen, Origin:=437, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
, Space:=False, TrailingMinusNumbers:=True

[schlagg]

Hi,

thanks for the welcome and the answer

so, i allready test this way, yes its very fast (almost no delay) but the problem is that it opens a new worksheet and me i have to stock the data in an existing worksheet (cause i've another worksheet which build a chart with those data)

if there is a way to import like in your code AND put the data in an existing worksheet, i think my problem will disapear

[Siddharth Rout]

Show me your existing workbook...

[westconn1]

if you import the data to a new sheet /book, you can then copy it to a position on an existing sheet, then remove the imported sheet / book

[schlagg]

here are the files in attachement.

westconn1 > what is the code for that? thanks

[anhn]

As I knew, at least to Excel 2003:
If use the Workbooks.OpenText method to open a file with extension ".csv",
Excel will open the file as a native Excel file with comma (,) delimited and
it will ignore all setting on other delimiters.

Particular in this case, two parameters Semicolon:=True, Comma:=False will have no effect.
Excel will treat the file with Comma:=True (and all other delimiters :=False)

* I don't know the reason why the code uses these 4 lines together:

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set Fichier = objFSO.OpenTextFile(FileToOpen, 1, True)
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(FileToOpen, 1, False)

[schlagg]

i deleted those 2 lines

Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(FileToOpen, 1, False)

they indeed are not necessary but script continue to work like before

[schlagg]

no one has any clue???

[westconn1]

as anhn says you can not correctly import a .csv file that is not csv (comma separated values), but easy enough to rename to .txt, then import
but as you filling is conditional, it may not help a lot

your existing code will be quicker if you populate a 2 dimensional array first then copy the array to the worksheet when finished

dim arr2() as variant
redim arr2 (1 to n, 1 to 10)
    i = 1
    Do Until Fichier.AtEndOfStream
        j = i - 1
        tab_line = Split(Fichier.ReadLine, ";")
    
        If i >= 2 Then
            arr2(j, 1) = tab_line(0)
            arr2(j, 2) = tab_line(1)
            arr2(j, 3) = tab_line(2)
            arr2(j, 7) = tab_line(6)
                        
            If i >= 3 Then
                arr2(j, 9) = ""     ' i presume you can remove any lines that assign empty values
                arr2(j, 10) = ""
                If tab_line(3) = 0 Then
                    arr2(j, 4) = ""
                    arr2(j, 5) = tab_line(4)
                    arr2(j, 6) = ""
                Else
                    arr2(j, 4) = tab_line(3)
                    arr2(j, 5) = ""
                    arr2(j, 6) = tab_line(5)
                End If
            Else
               arr2(j, 4) = tab_line(3)
               arr2(j, 5) = tab_line(4)
               arr2(j, 6) = tab_line(5)
            End If
        End If

at the end of the loop when finished reading csv file
fill the worksheet like

Feuil1.Range("a1").resize(n, 10) = arr2

this is untested, so i may have made some typo
test and see if any improvement

[anhn]

This will take you 1 second to import the file.

Sub Import_CSV()
    Dim FileToOpen As Variant
    Dim fs As Object
    Dim ts As Object
    Dim sLines() As String
    Dim tab_entete() As String
    Dim arr() As Variant
    Dim n As Long
    Dim r As Long
    Dim i As Long
    
    FileToOpen = Application.GetOpenFilename("Fichier CSV (*.csv), *.csv", , "Sélectionner le fichier à importer ...", , False)
    If FileToOpen = False Then Exit Sub
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(FileToOpen, 1, False)
    sLines = Split(ts.ReadAll, vbLf)
    ts.Close
    Set ts = Nothing
    Set fs = Nothing
    
    Application.ScreenUpdating = False
    
    tab_entete = Split(sLines(0), ";")
    n = Val(tab_entete(0))
    With Feuil1
        .UsedRange.ClearContents
        .Range("H1") = tab_entete(1)
        .Range("H2") = tab_entete(2)
        .Range("H3") = tab_entete(3)
    End With
    
    r = UBound(sLines)
    Do While Trim(sLines(r)) = "":  r = r - 1:  Loop
    
    ReDim arr(1 To r, 1 To 1)
    For i = 1 To r:   arr(i, 1) = sLines(i):   Next
    
    With Feuil1
        .Range("A1:A" & r) = arr
        .Range("A1:A" & r).TextToColumns Destination:=.Range("A1"), _
                DataType:=xlDelimited, Semicolon:=True, Tab:=False, Comma:=False, _
                Space:=False, Other:=False, ConsecutiveDelimiter:=False, FieldInfo:= _
                Array(Array(1, 1), Array(2, 5), Array(3, 1), Array(4, 1), _
                      Array(5, 1), Array(6, 1), Array(7, 1))
        arr = .Range("D2:F" & r)
        For i = 1 To r - 1
            If arr(i, 1) = 0 Then
                arr(i, 1) = ""
                arr(i, 3) = ""
            Else
                arr(i, 2) = ""
            End If
        Next
        .Range("D2:F" & r) = arr
    End With
    Application.ScreenUpdating = True
    
    Sheet1.ScrollBar1.Max = n - 23
    Unload u_progression
End Sub

[schlagg]

anhn and westconn1 > thanks for reply and tips

i don't tests them 'cause i find this post http://www.vbforums.com/showthread.php?t=562369 and it solve my problem

i test them when i've time 'cause the method is different and maybe i'll have to edit some lines before pasting them in excel.

thanks again for support