[SOLVED] Parsing CSV is randomly slow

:wave:

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 :

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 :

Code:

---

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 :ehh:
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

Welcome to the forums :wave:

Would something like this speed up your process?

Code:

---

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

---

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 :D

Show me your existing workbook...

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

here are the files in attachement.

westconn1 > what is the code for that? thanks :o

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:

Code:

---

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

---

i deleted those 2 lines

Code:

---

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

---

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

no one has any clue??? :(

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

vb Code:

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

vb Code:

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

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

This will take you 1 second to import the file.

Code:

---

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

---

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 ;)