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

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

As soon as I put this piece of VBA into the Workbook, and hit F8 to run it,
everything is greyed out - ie: I can only cancel.

Is there a way to speed this up? On the macro to open multiple files (which
is working) takes about 4 minutes to run as it has to open, read & close up
to 31 files. The files are large (125 columns, average 35,000 rows). What I
have for the multiple file open is:

Sub GetData()

DestSht = "sheet1"
With ThisWorkbook.Sheets(DestSht)
SearchData = .Range("A1").Text
End With

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

Dim vrtSelectedItem As Variant
With fd

If .Show = -1 Then

Call ReadCSV(Folder, SearchData, DestSht)

Next Folder
End If
End With

Set fd = Nothing

End Sub


Sub ReadCSV(ByVal Folder 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 = Dir(Folder & "\*.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()
Loop

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

Any assistance you can provide is much appreciated!
--
Linda


"RB Smissaert" wrote:

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

.

Hi

I cannot duplicate the grey out problem.
Two comments for your investigation:

In GetSingleFile
DestSht = "sheet1"
With ThisWorkbook.Sheets(DestSht)
SearchData = .Range("A1").Text
End With
probably do nothing;

In ReadCSV
There is a do without loop error

Regards


On Mar 8, 12:26*am, L.Mathe wrote:
As soon as I put this piece of VBA into the Workbook, and hit F8 to run it,
everything is greyed out - ie: *I can only cancel.

Is there a way to speed this up? *On the macro to open multiple files (which
is working) takes about 4 minutes to run as it has to open, read & close up
to 31 files. *The files are large (125 columns, average 35,000 rows). *What I
have for the multiple file open is:

Sub GetData()

DestSht = "sheet1"
With ThisWorkbook.Sheets(DestSht)
SearchData = .Range("A1").Text
End With

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

Dim vrtSelectedItem As Variant
With fd

If .Show = -1 Then

Call ReadCSV(Folder, SearchData, DestSht)

Next Folder
End If
End With

Set fd = Nothing

End Sub

Sub ReadCSV(ByVal Folder 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 = Dir(Folder & "\*.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()
Loop

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

Any assistance you can provide is much appreciated!
--
Linda



"RB Smissaert" wrote:
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

.- Hide quoted text -

- Show quoted text -

Ah, getting closer on this! I found why I could not run this sub
(dahhhhh....you cannot give the same name to 2 different sub-routines -
sometimes I can't see the forest for the trees)!

I added 'Loop' after FName=Dir() so it reads as:

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()
Loop

I now get Error: 400 - it doesn't say Run-Time Error or anything, just 400,
so I'm not sure of the problem. However, this is a piece of VBA I modified
where all files in a sub-directory are selected to search. I think it may
have something do with the statement FName = Dir()?

I am totally new to VBA (obviously), and totally lost! Your help is much
appreciated!

--
Linda


"PY & Associates" wrote:

Hi

I cannot duplicate the grey out problem.
Two comments for your investigation:

In GetSingleFile
DestSht = "sheet1"
With ThisWorkbook.Sheets(DestSht)
SearchData = .Range("A1").Text
End With
probably do nothing;

In ReadCSV
There is a do without loop error

Regards


On Mar 8, 12:26 am, L.Mathe wrote:
As soon as I put this piece of VBA into the Workbook, and hit F8 to run it,
everything is greyed out - ie: I can only cancel.

Is there a way to speed this up? On the macro to open multiple files (which
is working) takes about 4 minutes to run as it has to open, read & close up
to 31 files. The files are large (125 columns, average 35,000 rows). What I
have for the multiple file open is:

Sub GetData()

DestSht = "sheet1"
With ThisWorkbook.Sheets(DestSht)
SearchData = .Range("A1").Text
End With

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

Dim vrtSelectedItem As Variant
With fd

If .Show = -1 Then

Call ReadCSV(Folder, SearchData, DestSht)

Next Folder
End If
End With

Set fd = Nothing

End Sub

Sub ReadCSV(ByVal Folder 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 = Dir(Folder & "\*.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()
Loop

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

Any assistance you can provide is much appreciated!
--
Linda



"RB Smissaert" wrote:
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

.- Hide quoted text -

- Show quoted text -

.

Not sure if I can assist you.
I am doing all guess work.
Yes, you have got rid of one "do without loop" error.

In GetSingleFile
DestSht = "sheet1"
you assign DestSht as one of the parameters in ReadCSV

With ThisWorkbook.Sheets(DestSht)
I am stepping through the macro in a blank workbook which is
"ThisWorkBook"

SearchData = .Range("A1").Text
So the SearchData WILL BE NOTHING

When you call ReadCSV, myFileName has not yet been set.

Again in ReadCSV, you refer to ThisWorkBook(LastRow =
ThisWorkbook.Sheets(DestSht) _)
This is not myFileName, but my blank workbook.



On Mar 8, 9:25*pm, L.Mathe wrote:
Ah, getting closer on this! *I found why I could not run this sub
(dahhhhh....you cannot give the same name to 2 different sub-routines -
sometimes I can't see the forest for the trees)!

I added 'Loop' after FName=Dir() so it reads as:

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()
Loop

I now get Error: *400 - it doesn't say Run-Time Error or anything, just 400,
so I'm not sure of the problem. *However, this is a piece of VBA I modified
where all files in a sub-directory are selected to search. *I think it may
have something do with the statement FName = Dir()?

I am totally new to VBA (obviously), and totally lost! *Your help is much
appreciated!

--
Linda



"PY & Associates" wrote:
Hi

I cannot duplicate the grey out problem.
Two comments for your investigation:

In GetSingleFile
DestSht = "sheet1"
With ThisWorkbook.Sheets(DestSht)
SearchData = .Range("A1").Text
End With
probably do nothing;

In ReadCSV
There is a do without loop error

Regards

On Mar 8, 12:26 am, L.Mathe wrote:
As soon as I put this piece of VBA into the Workbook, and hit F8 to run it,
everything is greyed out - ie: *I can only cancel.

Is there a way to speed this up? *On the macro to open multiple files (which
is working) takes about 4 minutes to run as it has to open, read & close up
to 31 files. *The files are large (125 columns, average 35,000 rows). *What I
have for the multiple file open is:

Sub GetData()

DestSht = "sheet1"
With ThisWorkbook.Sheets(DestSht)
SearchData = .Range("A1").Text
End With

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

Dim vrtSelectedItem As Variant
With fd

If .Show = -1 Then

Call ReadCSV(Folder, SearchData, DestSht)

Next Folder
End If
End With

Set fd = Nothing

End Sub

Sub ReadCSV(ByVal Folder 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 = Dir(Folder & "\*.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()
Loop

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

Any assistance you can provide is much appreciated!
--
Linda

"RB Smissaert" wrote:
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

.- Hide quoted text -

- Show quoted text -

.- Hide quoted text -

- Show quoted text -