
Originally Posted by
SamT
Thanks. I have studied that thread closely and concluded that the code in post # 58 was probably the most relevant. However, I could not work out how to:
a) adapt #58 to replace my current code OR
b) merge part of my current code with #58.
For convenience, here's the code at #58. Very grateful for any help.
Option Explicit
Sub SNB__KenH_SamT()
Dim Filename As String
Dim NameLength As Long
Dim FileNameArray As Variant 'sn
Dim FileLinesArray As Variant 'sp
Dim Formula1LinesArray As Variant
Dim Formula1Result As Double 'y
'Repeat these two lies for each Formula. Edit the numbers to suit
Dim Formula2LinesArray As Variant
Dim Formula2Result As Double
Dim Fn As Long 'Fn = Index number for FileNameArray 'jj
Dim Fl As Long 'Fl = FileLinesArray Index number 'j
Const FolderPath As String = "C:\Users\dbrandejs\david\skola\IES\Diplomka\adjusted data\allstocks_20130102\" 'include ending \
'''' Put all the file names in the path in Array
FileNameArray = 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(FileNameArray)
MsgBox "Working on File " & FileNameArray(Fn)
''''Put all lines from one file in Arrays
FileLinesArray = Split(.opentextfile(FileNameArray(Fn)).readall, vbLf)
Formula1LinesArray = FileLinesArray
Formula2LinesArray = FileLinesArray
'Initializ
Formula1Result = 0
Formula2Result = 0
''''Calcuate first result for one file
For Fl = 0 To UBound(FileLinesArray) - 1
MsgBox " Line #" & Fl + 1 & " is" & vbCrLf & FileLinesArray(Fl)
'''' Calculate first formula
'Replace file line with Log of 6th value. Split(BlahBlah)(5)
Formula1LinesArray(Fl) = Log(Split(Formula1LinesArray(Fl), ",")(5))
'After the first line
If Fl > 0 Then Formula1Result = Formula1Result + Formula1Result + _
(Formula1LinesArray(Fl) - Formula1LinesArray(Fl - 1) ^ 2) * 100
Dim MsgAnswer
MsgAnswer = MsgBox("The Result is " & Formula1Result & vbCrLf & vbCrLf _
& "Press Cancel to stop run.", vbOkCancel)
If MsgAnswer = vbCancel Then Exit Sub
'''' Calculate second Formula here
'Replace file line with first part of formula. Think carefully
'Formula2LinesArray (Fl) = Your formula here
Next Fl
'''' Put results in sheet
'Get FileName
NameLength = Len(FileNameArray(Fn)) - InStrRev(FileNameArray(Fn), "\")
Filename = Right(FileNameArray(Fn), NameLength)
'Place result
With ActiveSheet.Rows(Fn + 1)
.Columns(2) = Formula1Result 'Column B
'.Columns(3) = Formula2Result
.Columns(1) = Filename
End With
'Initialize Arrays
FileLinesArray = ""
Formula1LinesArray = FileLinesArray
Formula2LinesArray = FileLinesArray
Next Fn 'Work on next File
End With
End Sub