@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
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 ?
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
@ 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.
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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 precisiononly 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
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
---------------------------------------------------------------------------------------------------------------------
Paul
Remember: Tell us WHAT you want to do, not HOW you think you want to do it
1. Use [CODE] ....[/CODE ] Tags for readability
[CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
2. Upload an example
Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
3. Mark the thread as [Solved] when you have an answer
Thread Tools (on the top right corner, above the first message)
4. Read the Forum FAQ, especially the part about cross-posting in other forums
http://www.vbaexpress.com/forum/faq...._new_faq_item3
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.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.
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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
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.
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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.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.
Last edited by SamT; 06-22-2015 at 06:35 AM.
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
@Maxxino
Check whether all subfolders are taken into account with
On my system it works flawlesslySub 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 ? ()
To - keep that Empty-Index-Stripper loop - is against any 'good coding practice'
Last edited by snb; 06-22-2015 at 09:55 AM.
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
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
Last edited by SamT; 06-23-2015 at 03:41 PM.
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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 )
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.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
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
Then replace Covar with covariance.p. I can only use what you give me.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)
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
WorksheetFunction.Covar(Param_1, Param_2)
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
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
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ