Excel Log Function is Log(Base10)
VBA Log Function is Natural Log
Change this line as shown
New result =Code:K_Array(CR) = Log(Split(FileLines(CR), ",")(F)) / Log(10#)
table_aapl_test.csv 0.50476314127199400
Printable View
Excel Log Function is Log(Base10)
VBA Log Function is Natural Log
Change this line as shown
New result =Code:K_Array(CR) = Log(Split(FileLines(CR), ",")(F)) / Log(10#)
table_aapl_test.csv 0.50476314127199400
What I learned:
Filter cannot return a value by location in an empty array. It raises a "Run-time error '9': Subscript out of range"
Math functions in VBA are not the same as the same function in Excel!
The final (Oh, I so hope,) product:
Code:Option Explicit
Sub SamT_4()
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 K_Array As Variant
Dim L_Array As Variant
Dim Sum_L As Double
Dim Fn As Long 'Fn = Index number for FileNames
Dim CR As Long 'CR = Column Arrays Index number. Same As Column Row number 'j
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 K_Array(UBound(FileLines))
ReDim L_Array(UBound(FileLines) + 1)
''''Log(F) into Column K
For CR = 0 To UBound(FileLines)
K_Array(CR) = Log(Split(FileLines(CR), ",")(F)) / Log(10#) '/Log(10) to match Excel Log Function
Next CR
''''Calculate Formula on Column K, put in Column L
For CR = 0 To UBound(K_Array) - 1 '-1 to compensate for column formula offsets
L_Array(CR + 1) = (100 * (K_Array(CR + 1) - K_Array(CR))) ^ 2
Next CR
''''Sum of Column L
For CR = 1 To UBound(L_Array)
Sum_L = Sum_L + L_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 ActiveSheet.Rows(Fn + 1)
.Columns(1) = Filename
.Columns(2) = Sum_L
End With
Next Fn 'Work on next File
End With
End Sub
Hi Sam, it is weird, this code works and the calculation in the first row (for table_aapl.csv) is correct, however to confirm the correctness of the calculation in the code I tried manually calculate next two files (table_abbv.csv and table_abt.csv) and they give me different results than the code:
table_abbv.csv 3.086788296 table_abt.csv 4.311690684
manual calculation:
table_abbv_test.xlsx 2.582025
table_abt_test.xlsx 1.224902
I send the xlsx files so you may see the equation I used.
Attachment 13670Attachment 13671
For instanceQuote:
Originally Posted by SamT
=Mod(12.34,5)
and
msgbox 12.34 mod 5
Or in strings
=trim("ad nmj kl p uw")
and
msgbox trim "ad nmj kl p uw"
NB. In post #6 in this thread you may find:
sp(jj) = Log(Split(sp(jj), ";")(5)) / Log(10)
Send me the original CSV files.. Don't Zip them, just change the Extensions to "txt"
I changed the extension to txt and tried to upload it, but "Invalid file" occured, thus I upload it via czech data share website:Quote:
Originally Posted by SamT
http://ulozto.cz/x9ifNzX8/table-aapl-txt
http://ulozto.cz/xdejuKhn/table-abbv-txt
http://ulozto.cz/xHjaJgZv/table-abt-txt
just pres "Sthánout", it means download.
If it helps you, I can share the whole dataset via ftp (cca 220 MB).
I have the files. Check back in a couple of hours. Maybe as much as 8 hours. I am busy today.
Those can not be downloaded by some. Zip your file(s) and then attach.
Here is how I found it. Left no possibilities to chance! First I performs all calculations by Sheet Formulas, then ran the code until I got a wrong value. Of course it was at the very end. A stupid omission. :banghead::banghead::banghead:Code:With Sheets("Sheet1").Rows(Fn + 1)
.Columns(1) = Filename
.Columns(2) = Sum_L
Sum_L = 0 '<<<<<<<<<<<<<<<Add this Line
End With
Code:Option Explicit
Sub SamT_4()
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 Double
Dim K_Array() As Double
Dim L_Array() As Double
Dim Sum_L As Double
Dim FName As String
Dim X
Dim Fn As Long 'Fn = Index number for FileNames
Dim CR As Long 'CR = Column Arrays Index number. Same As Column Row number 'j
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)
FName = Mid(FileNames(Fn), 17, Len(FileNames(Fn)) - 20)
''''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 K_Array(UBound(FileLines))
ReDim L_Array(UBound(FileLines) + 1)
''''Value F into F_Array
For CR = 0 To UBound(FileLines)
F_Array(CR) = Split(FileLines(CR), ",")(F)
X = Sheets(FName).Cells(CR + 1, 6).Value
If CDbl(F_Array(CR)) <> X Then
MsgBox FName & " Cell F" & CR + 1 & " Error."
Exit Sub
End If
Next CR
''''Log(F) into Column K
For CR = 0 To UBound(FileLines)
K_Array(CR) = Log(F_Array(CR)) / Log(10#) '/Log(10) to match Excel Log Function
X = Sheets(FName).Cells(CR + 1, 11).Value
If CDbl(K_Array(CR)) <> X Then
MsgBox FName & " Cell K" & CR + 1 & " Error."
Exit Sub
End If
Next CR
''''Calculate Formula on Column K, put in Column L
For CR = 0 To UBound(K_Array) - 1 '-1 to compensate for column formula offsets
L_Array(CR + 1) = (100 * (K_Array(CR + 1) - K_Array(CR))) ^ 2
X = Sheets(FName).Cells(CR + 2, 12).Value
If CDbl(L_Array(CR + 1)) <> X Then
MsgBox FName & " Cell K" & CR + 1 & " Error."
Exit Sub
End If
Next CR
''''Sum of Column L
For CR = 0 To UBound(L_Array)
Sum_L = Sum_L + L_Array(CR)
X = Sheets(FName).Cells(CR + 2, 13).Value
If CDbl(Sum_L) <> X Then
MsgBox FName & " Cell M" & CR + 1 & " Error" .'<<<<<<< Found Error Here
Exit Sub
End If
Next CR
'''' Put results in sheet
'Get FileName
NameLength = Len(FileNames(Fn)) - InStrRev(FileNames(Fn), "\")
Filename = Right(FileNames(Fn), NameLength)
'Place result
'With ActiveSheet.Rows(Fn + 1)
With Sheets("Sheet1").Rows(Fn + 1)
.Columns(1) = Filename
.Columns(2) = Sum_L
Sum_L = 0 '<<<<<<<<Add this Line
End With
Next Fn 'Work on next File
End With
End Sub
Hi Sam, it works!! you are great..thank you very much!!
and finally, as I wrote at the very beginning, I need to get the result of the second equation into the column C
the second equation is similar to first one, I attach the excel file with my manual calculation and pdf file to see the equation in real (see third equation BV_t),
just notice please that the number 94 that I use in the last step of the manual calculation stays for number of rows that are used for the calculation in given csv file,
thus it will be different in every csv file (it is not a constant), I believe there is a code in VBA that generates that number
btw I am writting to Jacob about the contribution, thanks again
Attachment 13730
http://ulozto.cz/x1LUbSuS/bv-calculation-pdf
Sorry Max, that PDF might as well be in Czech for all I know.
I asked you a long time before if there was only one equation to use on the CSV files. Now you have another. Maybe there are more equations.
take this attachment and put in all equations you need just like I put in this one and the first one. Use all the columns you need. Yellow cells show the formulas and Green shows the final result formula and all the notes.
Hi Sam, pdf is in English ofc, I uploaded it via Czech sharing website as it was not possible to upload it via "Manage attachments"
I wrote already in #5 that there will be two equations and subsequently I will perform some calculation directly in final excel file between columns B and C, , no other equations :)
It is exactly as you describe it in the attachment in #92, I will need only these two equations and put results in columns B and C
Maybe only it would be helpful if in column D there was this number of the rows that enter into the second calculation (for table_aabv_test.xlsx it is 94), but that's all :))
Maxxino
I knew the PDF was English, but it was Advanced Mathematics, which I forgot 40 years ago.
I am trying humor.
BTW, you will owe me a new Tatra, Left hand drive, 2 axles and Air-conditioned, please. :D
SamT -- you really earned your money on this one:beerchug:
Maxxino,
Here ya go.
Be sure and change the FolderPath Constant.
See Wiki article: Numeric precision in Microsoft Excel
Basically, Excel is limited to an arbitrary number of significant digits. When you multiply two decimal numbers the result has as many more significant digits than the first two. Both formulas start with Logs, which are very likely to have many significant digits.
The first formula merely adds the square of the logs, so probably only gains 1 or 2 significant digits and will probably be accurate to at least 10 digits.
The second formula performs chain-multiplication, X = (((((L1*L2)*L3)*L4)*L5),,,). The result of each of those operations is rounded at an arbitrary digit location. After a hundred or so operations the cumulative error starts creeping up towards a more significant location in the result.
Contrary to the Wiki article, I did not see an increase in presision when using Variant type variables instead of Long types. YMMV
Minor observations
1. I'd put Sub Subfolder_File_Processing() in a standard module and not in the sheet module
2. If precision is important (I haven't been following this too closely), maybe a Decimal data sub-type of a Variant would work. It's a bit more work to use CDec() but might be idea
Quote:
Decimal variables are stored as 96-bit (12-byte) signed integers scaled by a variable power of 10. The power of 10 scaling factor specifies the number of digits to the right of the decimal point, and ranges from 0 to 28. With a scale of 0 (no decimal places), the largest possible value is +/-79,228,162,514,264,337,593,543,950,335. With a 28 decimal places, the largest value is +/-7.9228162514264337593543950335 and the smallest, non-zero value is +/-0.0000000000000000000000000001.
Note
At this time the Decimal data type can only be used within a Variant, that is, you cannot declare a variable to be of type Decimal. You can, however, create a Variant whose subtype is Decimal using the CDec function.
I'm not sure that this would work any better (or at all)Code:
Option Explicit
' Thanks to all @ http://www.vbaexpress.com/forum/show...bFolders/page3
Sub Subfolder_File_Processing()
Const F As Long = 5 'CSV field number counting from zero
Const FolderPath As String = "C:\TestFolder\" 'include ending \
Dim Filename As String
Dim NameLength As Long
Dim FileNames As Variant
Dim FileLines As Variant
Dim F_Array() As Variant '-----------------------
Dim Sum_L As Variant '-----------------------
Dim Q_Array() As Variant '-----------------------
Dim Sum_Q As Variant '-----------------------
Dim Pie As Double
Pie = Application.WorksheetFunction.Pi() * 1# '----------------------- why?
Dim Fn As Long 'Fn = Index number for FileNames
Dim CR As Long 'CR = FileLines Index number
Dim NumRows As Long
' 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_L = CDec(0) '-----------------------
Sum_Q = CDec(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) = CDec(0) '-----------------------
F_Array(CR) = Log(Split(FileLines(CR), ",")(F)) / Log(10#) '-----------------------
'After the first line
If CR > 0 Then
Q_Array(CR) = CDec(0) '-----------------------
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
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
End With
Next Fn 'Work on next File
End With
End Sub
Variants are 16 bytes. I ran it with all variants, only converting to Decimal when placing the results on the sheet and without even that conversion and saws no difference.
After converting all numeric variable to Variants and using these calculations the results were identical to the 10th digit with the other methods. Note that I kept the Magic number 100. It made a difference when I subtituted the Variant C = CDec(100) for the Magic number
I believe that the VBA method is that much more precise than the Excel On-Sheet method, which is limited to 15 significant places.Code:''''Calcuate results for one file
For CR = 0 To UBound(FileLines)
'Replace file line with Log of 6th value. Split(BlahBlah)(5)
F_Array(CR) = CDec(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
Next CR
I need to go back and edit my "Accuracy" post above.
With 100 to 150 lines, Excel is accurate to +-3 in the third
With With Double Type numerical variables, VBA is accurate to 11 places
Assuming that using all decimals is the most precise.
1st Formula Results table_abbv.csv table_abt.csv table_aapl.csv Number of lines 94 106 151 Excel 2.5820251543270400 1.2249023888699800 0.5047631412720350 Doubles 2.5820251543270400 1.2249023888699900 0.5047631412719940 Decimal Variables 2.5820251543248600 1.2249023888700300 0.5047631412714680 2nd Formula Results Excel 1.7327113499938000 0.8586603953426530 0.4404276525780680 Doubles 1.7327113499937800 0.8597056301514100 0.4422153315780190 Decimal Variables 1.7327113499905900 0.8597056301520180 0.4422153315780510
Most precise version to data. (IMO)
Code:Option Explicit
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
Dim F_Array() As Variant
Dim Sum_L As Variant
Dim Q_Array() As Variant
Dim Sum_Q As Variant
Dim C As Variant
Dim Pie As Variant
Pie = CDec(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))
'Initialize
NumRows = UBound(FileLines) + 1
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) = CDec(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
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
End With
Next Fn 'Work on next File
End With
End Sub
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
Dim F_Array() As Variant
Dim Sum_L As Variant
Dim Q_Array() As Variant
Dim Sum_Q As Variant
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 \
'''' 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_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
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 * (94 / (94 - 1))) / 2)
.Columns(4) = NumRows
End With
Next Fn 'Work on next File
End With
End Sub
@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 ?
@ 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.
SamT --
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 precisionQuote:
only converting to Decimal when placing the results on the sheet and without even that conversion and saw no difference.
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 :crying:
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
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.Quote:
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
Like Richard Pryor in Superman, I want to balance my accounts to the hundred thousandths of a mil. :D :D :D
Just for reflection's sake:
Code: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
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.
splittting by vbCrLf instead of by vbLf
I see. But you (and I) started out using vbCrLf. What happened?
#52
Bad Dog! No biscuit for you. :razz2:Code:sp = Split(.opentextfile(sn(j)).readall, vbLf)
But I think I will keep that Empty-Index-Stripper loop. Ya never know what some User will do.
@Maxxino
Check whether all subfolders are taken into account with
On my system it works flawlesslyCode: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
If your pathname contains spaces SamT's code will let you down.
Mine ( # 106) is more robust.
@SamT
Would 'option Explicit' have helped ? (:devil2:)
To - keep that Empty-Index-Stripper loop - is against any 'good coding practice' ;)
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
Added Sum of Column G to procedure
Code: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
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 :):clap:
Thx again and pls let me know about the bank....or I will have to send just the beers :))
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.
Don't send money, mail me a thank you letter, On letterhead paper if appropriate.Code: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
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
Code: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
Then replace Covar with covariance.p. I can only use what you give me.Quote:
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)
Code:WorksheetFunction.Covar(Param_1, Param_2)
This works
Code:Param_2(CR - 2) = (F_Array(CR) - F_Array(CR - 1)) * 100
Code:.Columns(8) = WorksheetFunction.Covar(Param_1, Param_2)
table_aapl1.csv -5.15158E-05 table_abbv.csv -0.002501356 table_abt.csv -0.000789329