MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Extracting data from multiple files


Posted by Rob Purvis on November 21, 2001 4:39 AM

Scenario:

365 files exist, one for each day of the year, we need to extract the contents of 2 specific cells from a specific worksheet within each file and place this into a seperate workbook to give a new Spreadsheet containing 3 columns: date, value of cell1, value of cell2.


Posted by Dank on November 21, 2001 6:16 AM

Rob,

This macro will get the values of two cells from every workbook in a particular file and place them in a single workbook (the one containing the macro). When you say date, which date?

You could also do this using just formulas utilising the INDIRECT function.

Regards,
Daniel.

Sub ExtractData()
Dim strPath As String, shtDest As Worksheet, lngLoop As Long
Dim wbSource As Workbook

Application.ScreenUpdating = False
strPath = "C:\temp\year files" 'Change to suit your needs
Set shtDest = ThisWorkbook.Sheets("sheet1") 'Ditto


With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = strPath
.SearchSubFolders = False
.Execute
'Now search through all found files. Open the workbook and place it's values
'in this workbooks sheet1.
For lngLoop = 1 To .FoundFiles.Count
Set wbSource = Workbooks.Open(.FoundFiles(lngLoop))
shtDest.Cells(lngLoop, 1) = wbSource.Name
shtDest.Cells(lngLoop, 2) = wbSource.Sheets("sheet1").Range("A1")
shtDest.Cells(lngLoop, 3) = wbSource.Sheets("sheet1").Range("B1")
wbSource.Close False
Next lngLoop
End With

Application.ScreenUpdating = True

End Sub

Posted by Rob Purvis on November 22, 2001 2:48 AM

This is nearly working, the Source directory is c:\Year 2000, the worksheet is labelled 'Extract', the two cells to grab are C25 & C26, as far as the "date" goes then the current code you gave is fine as it inserts the filename which is perfect.

I've had a play with the code but I can't get it right, i've never used vb or macros before.

TIA

Rob.

Posted by Dank on November 22, 2001 3:26 AM

What is the actual problem then? The biggest potential problem I could see is any reference to 'sheet1' where you source worksheets may have different names. This code is slightly modified to match your changes specified:-

Regards,
Daniel.

Sub ExtractData()
Dim strPath As String, shtDest As Worksheet, lngLoop As Long
Dim wbSource As Workbook

Application.ScreenUpdating = False
strPath = "C:\year 2000" 'Change to suit your needs
Set shtDest = ThisWorkbook.Sheets("sheet1") 'Ditto


With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = strPath
.SearchSubFolders = False
.Execute
'Now search through all found files. Open the workbook and place it's values
'in this workbooks sheet1.
For lngLoop = 1 To .FoundFiles.Count
Set wbSource = Workbooks.Open(.FoundFiles(lngLoop))
shtDest.Cells(lngLoop, 1) = wbSource.Name
shtDest.Cells(lngLoop, 2) = wbSource.Sheets("sheet1").Range("C25")
shtDest.Cells(lngLoop, 3) = wbSource.Sheets("sheet1").Range("C26")
wbSource.Close False
Next lngLoop
End With

Application.ScreenUpdating = True

End Sub

Posted by Rob Purvis on November 22, 2001 8:20 AM

Thanks Dank, I managed to get this to do what I needed although I had to put an error skip in due to "Subscript out of range" after it accessed the second file.

Cheers,

Rob.