I need to extract rows of data from 200+ SPREADSHEETS.

[TomTaylor]

I have 200 plus spreadsheet files, (not worksheets) all in the same column format, each about 8 columns and 200-500 rows each. Named A001.XLS, A002.XLS, etc.

If a row contains the value of "1" in column D I need to extract that row to a new spreadsheet, txt file, what have you.

Naturally this is a crisis for today. Any ideas or help appreciated.

I know its going the wrong way but if I could convert all of the .xls files to .csv or .txt and concantanate(sp) them I would be able to handle if from there.

Other posts have addressed the issue of doing this with 100+ worksheets in the same spreadsheet file. How could I get all these Spreadsheet .xls files combined into one file?

Thank you.

Tom

 

[tmischler]

It wouldn't be the quickest I am sure but if you open say 10 workbooks at a time and click window, arrange, tiled and drag the worksheets into a new book, you would get there in the not toooooo distant future.

 

[TomTaylor]

Desperation can be a powerful motivator, These are essentially daily files since January, so I could lump them into a monthly file. But before I undertake that manual task, I would like to understand the data capacity limits of Excel, so that I don't do all the manual labor and then discover that the file is too large to perform any data conversion.

Any ideas where Excel starts to break?

 

[Norie]

Other posts have addressed the issue of doing this with 100+ worksheets in the same spreadsheet file. How could I get all these Spreadsheet .xls files combined into one file?

The code for these can easily be adapted.

You would need to follow the following steps:

1. Create an array with all the filenames A001.xls etc. This can be done using the FileSearch object - check XL help or do a search on the board.

2. Open each file. Easily done with something like the following

Set wbData = Application.Workbooks.Open(MyFileName)

Where MyFileName is A001.xls etc

3. Search all the worksheets in the workbook according to your criteria and paste that row into a new row in new workbook.

To access each worksheet you can use something like this:

For each ws in wbData.Worksheets
' search for criteria and copy to new workbook
Next

4. Close the workbook and open next one

You will find detailed code for each step on the board - you just need to combine it correctly.

Give it a try and if you encounter any problems post the code.

 

[kjo1080]

This should work, but it has limited testing. You will need to change the bold items below for you specific needs. Also in the "Do While filepart < 250" you need to put in the exact number of files. "I:\Bsd\" & filename refers to you specif location of your file. Windows("MacroTest.xls").Activate is whatever you name the file you want you rows pasted to. This should also be the file that you paste and run this macro from! Let me know if you have questions!

Sub ExtractData()

Dim filename As Variant
Dim File As Variant
Dim filepart As Variant
Dim fileNM As Integer
Dim cell

Range("a1").Select
fileNM = 1
filepart = Format(fileNM, "000")
File = "A" & filepart

Do While filepart < 250

filename = File & ".xls"

Workbooks.Open filename:= _
"I:\Bsd\" & filename

For cell = 1 To Range("a65536").End(xlUp).Row
If Range("D" & cell).Value = 1 Then
Rows(cell).Copy
Windows("MacroTest.xls").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
Windows(filename).Activate
Else
'Next i
End If
Next cell
Windows(filename).Close
fileNM = fileNM + 1
filepart = Format(fileNM, "000")
File = "A" & filepart

Loop

End Sub

 

[TomTaylor]

Well the post from kjo1080 sure looks like it will get me going, but I am so handicapped, I don't know how to get to the point where I can use the code. Can someone get me from "Open Excel" to push this button to run your code???

 

[Nimrod]

Hello Tom:
I believe I can write you some code that would make short work of this without having to open up a single book as long as 2 criteria / conditions can be met :
1. The files can all be put into one directory with no other xls books in it .
2. Each book has the info on sheets with exactly the same name .

Can you meet this two conditions ??

 

[TomTaylor]

Nimrod,

The files can all be assembled in one directory by themselves.

The files will have the same column layout, Two Title rows, a blank row
and then data rows. Basically if column D is not blank ( it may contaain a single letter or number) I would like to extract it to a new worksheet.

Would it be possible to insert a column showing the name of the file
the data row came from?

The .xls files will have difffering number of rows in them, 300-600 each.
and may contain blank rows within the data, will that be fatal. Most likely
the rows to be extracted will be before the first blank row.

Thank you for your help in advance.

 

[Nimrod]

Tom ..
That's all great but you still haven't let me know if you can meet both of my conditions... namely you haven't told me if the sheet in each workbook has the same name... if so then I can have a solution ready for you in 10 minutes. :wink:

SECOND THING TO CLARIFY.. In your first post you said you only wanted a row if Column D had the Value = 1 , however now your talking about wanting it as long as it's not blank ... could you please let me know which it is ??

 

[Nimrod]

Well Tom:
I'm going to give you a solution that should work , though I wish I could have gotten my 2 questions answered before doing the coding .

The following procedure "GetDirXlsContents" is the code that you must configure and Run. It will call the other procedure with the details that you configure in GetDirXlsContents.

THINGS TO CONFIGURE IN "GetDirXlsContentS"

SHEETNAME
I've configured the Source Sheet as "Sheet1" if all workbooks have a specific sheet inside it then change this value to what ever it is. If the sheets have multiple sheets of data then run this one for each sheet name. If all books have different named sheets then change this varible to "shxyzzyz" and the program will ask you to select the appropriate sheet in each book.

PATH:
The path / directory has been set up as "C:\test" . Please modify to point to the directory where all files are stored ... note the missing trailing "\" . If you put a final "\" the system will fail.
Example: If you source files are in the directory called Nimrod , of the C root , then the Path should be changed from "C:\test" to "C:\Nimrod"

RANGE:
This is the range of cells that will be scanned for data.

Public Sub GetDirXlsContents()
' Source sheet name, Source directory path, Source cell Range
Call CopyFromEachFileInPath("Sheet1", "C:\test", "A1:I500")
End Sub

Private Sub CopyFromEachFileInPath(SheetName, Path, Rng)
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Path & "\")
Set fc = f.Files

' make a temp sheet
Application.ScreenUpdating = False
TargSh = ActiveSheet.Name
Sheets.Add
TempSh = ActiveSheet.Name
Sheets(TargSh).Activate
Application.ScreenUpdating = True

For Each f1 In fc
With Sheets(TempSh)

' clear temp sheet and start again
.Cells.ClearContents

' Place Src Info on Temp Targ Sheet
If Right(f1.Name, 3) = "xls" Then
fName = Left(f1.Name, Len(f1.Name) - 4)
.Range(Rng).FormulaArray = "='" & Path & "\[" & fName & "]" & SheetName & "'!" & Rng
.Range(Rng).Value = .Range(Rng).Value

'GetValuesFromAClosedWorkbook Path, f1.Name, SheetName, "A1:K30"
End If

' if columD = 1 copy over
For Each D In .Columns("D:D").SpecialCells(xlCellTypeConstants, 1)
If Not D.Value = 0 Then ' copy to final sheet
NxRw = Cells(65536, 4).End(xlUp).Row + 1
Range("A" & NxRw & ":I" & NxRw).Value = .Range("A" & D.Row & ":Z" & D.Row).Value
Range("J" & NxRw).Value = fName
End If
Next D
End With
' have user see list build, so know not frozen
Cells(NxRw, 1).Select
Next ' workbook

' get rid of temp sheet
Application.DisplayAlerts = False
Sheets(TempSh).Delete
Application.DisplayAlerts = True
End Sub



TO INSTALL CODE in module:
1.Open the Workbook you want code copied into
2.Press the Keys ALT and F11 at the same time (this open VBE window)
3.In VBE window goto tool bar and click "INSERT"
4.On Insert drop down menu click "Module"
5.A new module winow will appear on the rt side of VBE
6.Paste the code and close VBE by pressing ALT + F11

TO RUN MY CODE:
1.While the sheet to evaluate is active goto tool bar
2. ON tool bar goto "Tools...Macro....Macros"
3. A list of Macros should appear
4. To run the above Macro Double Click on it's name in the list