Any ideas how to get this code to run faster please? I'm reading
in a text file with stocks data in the following format:
JRV,Jervois SUM,D,20090807,000000,0.00600,0.00600,0.00500,0.00600,41370,0
JYC,Joyce SUM,D,19900102,000000,1.25410,1.25410,1.25410,1.25410,0,0
etc...
which then compares the three-letter code with a list in the following
format to create a new text file where data is only included if the code
is on the list. Since I added the range search to the code it
runs VERY slow Thanks for any help!
AAC Aust A Foo
AAF Austral Af Mat
AAM A1 Mineral Mat
AAR Anglo Aust Mat
AAX Ausenco Li Cap
ABB Abb Grain Foo
ABC Adelaide B Mat
etc...
Sub DatFileDataCleanser()
'Create new ascii file from input created from dat files
'data only included if code matches list from 'All Stocks' sheet
Dim LineOfText As String
Dim vValues As Variant
Dim vValue As Variant
Dim iCount As Integer
Dim sInputCode As String
Dim sOutputCode As String
Dim iOutputDate As Integer
Dim sFName As String
Dim sFPath As String
Dim sInFNamePath As String
Dim sOutFNamePath As String
Dim iOutFNum As Integer
Dim iInputFNum As Integer
Dim sTitleData As String 'heading required to create Dta file
Dim rData As Range
Dim rFind As Range
Dim sFind As String
Dim sOutCompanyName As String
Dim sOutCompanySector As String
Dim sOutputText As String
Dim sOutputDate As String
Dim sNumericCode As Boolean 'checks to see if numbers in Ticker Code
Dim sClose As String
Dim sTotalStocks As Long
Dim sInputType As String
Dim sWatchRange As Range
Dim i As Integer
Dim Cell As Range
Dim DoInclude As Object
Dim ssKey As String
Dim Master As Range
Dim DoList As Range
Dim R As Long
Dim Rng As Range
Dim RngEnd As Range
Const sComma As String = ","
sFName = Dir$("C:\MS2Dat\temp\*.txt")
sFPath = "C:\MS2Dat\temp\"
sInFNamePath = sFPath + sFName
sOutFNamePath = sFPath + "AllStocks.txt"
Open sOutFNamePath For Output As #2
sTitleData = "<TICKER>,<NAME>,<PER>,<DATE>,<TIME>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>,<OPENINT>"
Print #2, sTitleData
Do While Len(sFName) > 0
iInputFNum = FreeFile
Open sInFNamePath For Input As iInputFNum
'Define the location and start of the list
Set DoList = Worksheets("All Stocks").Range("A1")
Set DoInclude = CreateObject("Scripting.Dictionary")
DoInclude.CompareMode = vbTextCompare
'Find the range length of the list of stocks to include
Set Rng = DoList
Set RngEnd = Rng.Parent.Cells(Rows.Count, Rng.Column).End(xlUp)
Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Rng.Parent.Range(Rng, RngEnd))
'Load the list of stocks to include
For Each Cell In Rng
sKey = Trim(Cell.Text)
If sKey <> "" And DoInclude.Exists(sKey) = False Then
DoInclude.Add sKey, 1
End If
Next Cell
Do Until EOF(1)
Line Input #1, LineOfText
If Mid(LineOfText, 4, 1) = "," Then 'Ensure it's a three letter code, not an option stock
vValues = Split(LineOfText, sComma)
ssKey = vValues(0)
If ssKey <> "" And DoInclude.Exists(sKey) = True Then
'insert code to take correct stock name from list in column b next to ticker list
'and insert in LineOfText:
For Each rData In Rng
sFind = rData.Value
If sFind = ssKey Then
sOutCompanyName = rData.Offset(0, 1)
sOutCompanySector = rData.Offset(0, 2)
sOutputText = ssKey & "," & sOutCompanyName & " " & sOutCompanySector & ",D," & _
vValues(3) & "," & vValues(4) & "," & vValues(5) & "," & vValues(6) _
& "," & vValues(7) & "," & vValues(8) & "," & vValues(9) & "," & vValues(10)
Print #2, sOutputText
Exit For
End If
Next rData
End If
End If
Loop
Close iInputFNum
' Get next file name
sFName = Dir$
sFPath = "C:\MS2Dat\"
sInFNamePath = sFPath + sFName
Loop
Close #2
End Sub
Bookmarks