Don't know if it will suit your requirements and not sure if speed is
important, but you could probably speed this up a lot by opening
the .csv files to a variant array and searching that, instead of opening the
files to Excel.

What doesn't work or where in your code does it go wrong?

RBS


"L.Mathe" wrote in message
...
Hi,

I'm using Excel 2003 and have a macro that allows a user to select files
in
a sub directory, does a search for specific data in each file, extracts
data
in another column if there is a match, etc. I also require that the user
can
select a single file. I tried to modify the code I have, but it will not
work.

Any help would be appreciated..... this is what I have tried:

Sub GetSingleFile()

Dim FileName As Variant
FileName = Application.GetOpenFilename
If FileName = False Then
Debug.Print "user cancelled"
Else
Debug.Print "file selected: " & FileName
End If
DestSht = "sheet1"
With ThisWorkbook.Sheets(DestSht)
SearchData = .Range("A1").Text
End With

Call ReadCSV(myFileName, SearchData, DestSht)

End Sub

Sub ReadCSV(ByVal myFileName As Variant, ByVal SearchData As String, ByVal
DestSht)

Dim Data As String
Dim Data1 As Date
Dim Data2 As String
Dim Data3 As String

LastRow = ThisWorkbook.Sheets(DestSht) _
.Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
RowCount = NewRow
FName = "h:\myFile.csv"
Do While FName < ""

Workbooks.OpenText FileName:=Folder & "\" & FName, _
DataType:=xlDelimited, Comma:=True
Set CSVFile = ActiveWorkbook
Set CSVSht = CSVFile.Sheets(1)
'check if data exists in column 77
Set c = CSVSht.Columns(77).Find(What:=SearchData, _
LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
FirstAddr = c.Address
Do
Data1 = CSVSht.Cells(c.Row, 110)
Data2 = CSVSht.Cells(c.Row, 70)
Data3 = Left(Data2, 19)

With ThisWorkbook.Sheets(DestSht)
.Range("B" & RowCount) = FName
.Range("A" & RowCount) = Data3

RowCount = RowCount + 1
End With
Set c = CSVSht.Columns(77).FindNext(after:=c)
Loop While Not c Is Nothing And c.Address < FirstAddr
End If
CSVFile.Close savechanges:=False

FName = Dir()

Application.ScreenUpdating = False
Range("A3:B500").Select
Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A3").Select

Application.ScreenUpdating = True
MsgBox "Search Is Complete", vbInformation


End Sub


Thank you!
--
Linda