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