Process All CSV Files In SubFolders

[snb]

@SamT

Hi Sam,

Can you inform me about the difference of your last code compared to the code in http://www.vbaexpress.com/forum/show...l=1#post325010 ?

[SamT]

More Reading:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=887
http://www.extremeoptimization.com/D...n/Default.aspx
http://www.tushar-mehta.com/misc_tut...Arithmetic.htm

[SamT]

@ snb,

?

It has one more formula and is more verbose. That is why I credited all here. I was standing on your shoulders, propped up by many others.

I am not clear yet on the difference in Precision/Accuracy between the Variant Type and the Decimal Type, but the reading I've done hints that the use of Decimal Types is preferred.

On the three files available, use of the Variant Type gave the same results as when using Doubles.

[Paul_Hossler]

SamT --

only converting to Decimal when placing the results on the sheet and without even that conversion and saw no difference.

I would think that if all the internal calculations were done with 'low' precision Doubles, then converting that to 'higher' precision Decimal at the end would not show additional precision

I'd kind of leaning towards thinking that the Log() function will only return Double level precision, so I doubt that using Decimals will offer any improvement


As an aside, there is an add-in that allows up to 32760 digits to the right of the decimal point. I never needed that to balance my checkbook, but as an old retired math major, I found it interesting

www.thetropicalevents.com/Xnumbers60

[SamT]

I'd kind of leaning towards thinking that the Log() function will only return Double level precision, so I doubt that using Decimals will offer any improvement

My thoughts were that it made the Array values Decimal. It doesn't make much difference in the first calculation which is just adding the squares of the difference in two numbers, but in the second calculation, which is a chain of multiplications, it seems to rally help. Of course Maxximo told me in a PM that 3 in the 3rd is good enough for him.

Like Richard Pryor in Superman, I want to balance my accounts to the hundred thousandths of a mil.

[snb]

Just for reflection's sake:

Sub M_snb()
    c00 = "C:\TestFolder\"
    sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & c00 & "*.csv"" /b /s").stdout.readall, vbCrLf), ".")
     
    With CreateObject("scripting.filesystemobject")
        For j = 0 To UBound(sn)
          sp = Filter(Split(.opentextfile(sn(j)).readall, vbCrLf), ",")
          
          For jj = 0 To UBound(sp)
            sp(jj) = Log(Split(sp(jj), ",")(5)) / Log(10)
            If j > 1 Then y = y + Abs(sp(jj - 1) - sp(jj - 2)) * Abs(sp(jj) - sn(jj - 1))
          Next
          
          sn(j) = [Pi() / 2] * y * (UBound(sp) + 1) / UBound(sn) * 10 ^ 4
        Next
    End With
    
    Sheet1.Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

[SamT]

Since I lifted your Filter-Split in toto, why doesn't that version error out at the extra carriage return? sp(Ubound(sp)) was empty in my version.

[snb]

splittting by vbCrLf instead of by vbLf

[SamT]

I see. But you (and I) started out using vbCrLf. What happened?

#52

 sp = Split(.opentextfile(sn(j)).readall, vbLf)

Bad Dog! No biscuit for you.

But I think I will keep that Empty-Index-Stripper loop. Ya never know what some User will do.

[snb]

@Maxxino

Check whether all subfolders are taken into account with

Sub M_snb()
    c00 = "G:\OF\"
    
    sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & c00 & "*.csv"" /b/s").stdout.readall, vbCrLf), ".")
    Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

On my system it works flawlessly

If your pathname contains spaces SamT's code will let you down.
Mine ( # 106) is more robust.



@SamT

Would 'option Explicit' have helped ? ()
To - keep that Empty-Index-Stripper loop - is against any 'good coding practice'

[maxxino]

SamT - the accuracy has increased as I adjusted this line: .Columns(3) = ((Sum_Q * Pie * (NumRows / (NumRows - 1))) / 2)

snb - it works now, the code was in Sheet1, I moved it to Module, thx

[SamT]

Added Sum of Column G to procedure

Sub Precise_Subfolder_File_Processing()
'16-Byte accuracy
' Thanks to all @ http://www.vbaexpress.com/forum/showthread.php?52649-Process-All-CSV-Files-In-SubFolders/page3

Dim Filename As String
Dim NameLength As Long
 
Dim FileNames As Variant
Dim FileLines As Variant
Const F As Long = 5 'CSV field number counting from zero
Const G As Long = 6  '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
Dim F_Array() As Variant
Dim Sum_L As Variant
Dim Q_Array() As Variant
Dim Sum_Q As Variant
Dim Sum_G As Long '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim Pie As Double
Pie = Application.WorksheetFunction.Pi() * 1
 
Dim Fn As Long 'Fn = Index number for FileNames
Dim CR As Long 'CR = FileLines Index number
Dim NumRows As Long
 
Const FolderPath As String = "C:\TestFolder\" 'include ending \

Application.ScreenUpdating = False '<<<<<<<<<<<<<Added for speed. Comment out to watch process
     
   '''' Put all the file names in the path in Array
  FileNames = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & _
    FolderPath & "*.csv /b /s").stdout.readall, vbCrLf), ".")
   
   '''' Open one file at a time
  With CreateObject("scripting.filesystemobject")
    For Fn = 0 To UBound(FileNames)
     
''''Put all lines from one file in Arrays
      FileLines = Split(.opentextfile(FileNames(Fn)).readall, vbLf)
       
       'Compensate for extra vbLf's in FileLines
      Do While FileLines(UBound(FileLines)) = ""
         ReDim Preserve FileLines(UBound(FileLines) - 1)
      Loop
       
      ReDim F_Array(UBound(FileLines))
      ReDim Q_Array(UBound(FileLines))
       
       'Initialize
      NumRows = UBound(FileLines) + 1
      Sum_G = 0 '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      Sum_L = 0
      Sum_Q = 0
    
''''Calcuate first result for one file
      For CR = 0 To UBound(FileLines)
         'Replace file line with Log of 6th value. Split(BlahBlah)(5)
        F_Array(CR) = Log(Split(FileLines(CR), ",")(F)) / Log(10#)
         'After the first line
        If CR > 0 Then
          Sum_L = Sum_L + ((F_Array(CR) - F_Array(CR - 1)) * 100) ^ 2
          Q_Array(CR) = Abs((F_Array(CR) - F_Array(CR - 1)) * 100)
          Sum_Q = Sum_Q + (Q_Array(CR) * Q_Array(CR - 1))
        End If
        Sum_G = Sum_G + Split(FileLines(CR), ",")(G) '<<<<<<<<<<<<<<
      Next CR
     
'''' Put results in sheet
     'Get FileName
      NameLength = Len(FileNames(Fn)) - InStrRev(FileNames(Fn), "\")
      Filename = Right(FileNames(Fn), NameLength)

       
       'Place result
      With Sheets("Sheet1").Rows(Fn + 1)
          .Columns(1) = Filename
          .Columns(2) = (Sum_L)
          .Columns(3) = ((Sum_Q * Pie * (NumRows / NumRows - 1))) / 2)
          .Columns(4) = NumRows
          .Columns(5) = Sum_G '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      End With
     
    Next Fn 'Work on next File
  End With
Application.ScreenUpdating = True '<<<< Reset to default
End Sub

[maxxino]

If I run #112, it shows all zeros in column 3, however I took new lines (except the one added for speed) and put it into previous "fast" code and it works just fine

Thx again and pls let me know about the bank....or I will have to send just the beers )

[SamT]

Here is one with only the new formulas in it. I only checked the results against the Table_abbv(3) sheet you sent. I left the filenames and the sum of Columne G in for your verification of the results. Either comment out those lines or run it on a blank sheet.

Sub Fast_Subfolder_File_Processing()
'8-Byte accuracy
' Thanks to all @ http://www.vbaexpress.com/forum/showthread.php?52649-Process-All-CSV-Files-In-SubFolders/page3

Dim Filename As String
Dim NameLength As Long
 
Dim FileNames As Variant
Dim FileLines As Variant
Const F As Long = 5 'CSV field number counting from zero
Const G As Long = 6
 
Dim F_Array() As Double
'Dim Sum_L As Double
'Dim Q_Array() As Double
'Dim Sum_Q As Double
Dim G_Array() As Double
Dim Sum_G As Double '<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim Sum_O As Double
Dim Sum_P As Double
Dim Temp_M As Double

Dim Pie As Double
Pie = Application.WorksheetFunction.Pi()
 
Dim Fn As Long 'Fn = Index number for FileNames
Dim CR As Long 'CR = FileLines Index number
Dim NumRows As Long
 
Const FolderPath As String = "C:\TestFolder\" 'include ending \
     
   '''' Put all the file names in the path in Array
  FileNames = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & _
    FolderPath & "*.csv /b /s").stdout.readall, vbCrLf), ".")
   
   '''' Open one file at a time
  With CreateObject("scripting.filesystemobject")
    For Fn = 0 To UBound(FileNames)
     
''''Put all lines from one file in Arrays
      FileLines = Split(.opentextfile(FileNames(Fn)).readall, vbLf)
       
       'Compensate for extra vbLf's in FileLines
      Do While FileLines(UBound(FileLines)) = ""
         ReDim Preserve FileLines(UBound(FileLines) - 1)
      Loop
       
      ReDim F_Array(UBound(FileLines))
      ReDim Q_Array(UBound(FileLines))
      ReDim G_Array(UBound(FileLines))
       
       'Initialize
      NumRows = UBound(FileLines) + 1
      'Sum_L = 0
      'Sum_Q = 0
      Sum_G = 0
      Sum_O = 0
      Sum_P = 0 '<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    
''''Calcuate first result for one file
      For CR = 0 To UBound(FileLines)
         'Replace file line with Log of 6th value. Split(BlahBlah)(5)
        F_Array(CR) = Log(Split(FileLines(CR), ",")(F)) / Log(10#)
        G_Array(CR) = Split(FileLines(CR), ",")(G)
         'After the first line
        If CR > 0 Then
          If F_Array(CR) - F_Array(CR - 1) <> 0 Then
          Temp_M = 100 * Abs(F_Array(CR) - F_Array(CR - 1))
          Sum_O = Sum_O + Temp_M / G_Array(CR)
          Sum_P = Sum_P + G_Array(CR) / Temp_M
          End If
        End If
        Sum_G = Sum_G + G_Array(CR)
      Next CR
     
'''' Put results in sheet
     'Get FileName
      NameLength = Len(FileNames(Fn)) - InStrRev(FileNames(Fn), "\")
      Filename = Right(FileNames(Fn), NameLength)

       
       'Place result
      With Sheets("Sheet1").Rows(Fn + 1)
          .Columns(1) = Filename
          '.Columns(2) = Sum_L 'Column B
          '.Columns(3) = (Sum_Q * Pie * (94 / (94 - 1))) / 2
          '.Columns(4) = NumRows
          '.Columns(5) = Sum_G
          .Columns(6) = Sum_O '<<<<<<<<<<<<<<<<<<<<<<<<<<
          .Columns(7) = Sum_P
      End With
     
    Next Fn 'Work on next File
  End With
End Sub

Don't send money, mail me a thank you letter, On letterhead paper if appropriate.

[SamT]

Here are the result I got on three files

table_aapl.csv				20887611	0.00061	1362412839
table_abbv.csv				13768906	0.006232	295734939.5
table_abt.csv				20283788	0.002766	3467549458

[SamT]

Sub Get_Convar()
     '16-Byte accuracy
     ' Thanks to all @ http://www.vbaexpress.com/forum/showthread.php?52649-Process-All-CSV-Files-In-SubFolders/page3
     
    Dim Filename As String
    Dim NameLength As Long
     
    Dim FileNames As Variant
    Dim FileLines As Variant
    Const F As Long = 5 'CSV field number counting from zero
     
    Dim F_Array() As Variant
    Dim Param_1() As Variant
    Dim Param_2() As Variant
     
    Dim Fn As Long 'Fn = Index number for FileNames
    Dim CR As Long 'CR = FileLines Index number
     
    Const FolderPath As String = "C:\TestFolder\" 'include ending \
     
    Application.ScreenUpdating = False '<<<<<<<<<<<<<Added for speed. Comment out to watch process
     
     '''' Put all the file names in the path in Array
    FileNames = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & _
    FolderPath & "*.csv /b /s").stdout.readall, vbCrLf), ".")
     
     '''' Open one file at a time
    With CreateObject("scripting.filesystemobject")
        For Fn = 0 To UBound(FileNames)
             
             ''''Put all lines from one file in Arrays
            FileLines = Split(.opentextfile(FileNames(Fn)).readall, vbLf)
             
             'Compensate for extra vbLf's in FileLines
            Do While FileLines(UBound(FileLines)) = ""
                ReDim Preserve FileLines(UBound(FileLines) - 1)
            Loop
             
            ReDim F_Array(UBound(FileLines))
            ReDim Param_1(UBound(FileLines) - 2)
            ReDim Param_2(UBound(FileLines) - 2)
             
            For CR = 0 To UBound(FileLines)
                 'Replace file line with Log of 6th value. Split(BlahBlah)(5)
                F_Array(CR) = Log(Split(FileLines(CR), ",")(F)) / Log(10#)
                 'After the first line
                If CR > 0 And CR < UBound(FileLines) Then _
                    Param_1(CR - 1) = (F_Array(CR) - F_Array(CR - 1)) * 100
                If CR > 1 Then _
                  Param_2(CR - 1) = (F_Array(CR) - F_Array(CR - 1)) * 100
            Next CR
             
             '''' Put results in sheet
             'Get FileName
            NameLength = Len(FileNames(Fn)) - InStrRev(FileNames(Fn), "\")
            Filename = Right(FileNames(Fn), NameLength)
             
             
             'Place result
            With Sheets("Sheet1").Rows(Fn + 1)
                .Columns(1) = Filename
                '.Columns(2) = (Sum_L)
                '.Columns(3) = ((Sum_Q * Pie * (NumRows / NumRows - 1))) / 2)
                '.Columns(4) = NumRows
                '.Columns(5) = Sum_G '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                .Columns(8) = WorkdheetFunction(Covar(Param_1, Param_2))
            End With
             
        Next Fn 'Work on next File
    End With
    Application.ScreenUpdating = True '<<<< Reset to default
End Sub

[SamT]

Hi Sam, thanks, just that there is a compile error: Sub or Function not defined (Covar). Could it be idk e.g. that you have a different version of Office? I have 2013.
Because I know that in previous Excels covar was a valid function, but in Excel 2013 covariance.p is its replacement (eventhough in Excel 2013 covar still works, but idk whether it is the same with VBA)

Then replace Covar with covariance.p. I can only use what you give me.

[SamT]

WorksheetFunction.Covar(Param_1, Param_2)

[SamT]

This works

Param_2(CR - 2) = (F_Array(CR) - F_Array(CR - 1)) * 100

.Columns(8) = WorksheetFunction.Covar(Param_1, Param_2)

table_aapl1.csv	-5.15158E-05
table_abbv.csv	-0.002501356
table_abt.csv	-0.000789329