Extracting data from multiple workbooks.

[cabala]

Hello all,

I am facing a very serious problem. I need help in form of an excel macro. I will explain my torubles in short.

I want to extract data from some 12000 work books and pasted in a newworkbook. all this while without opening those 12000 files.

Info:
Files :"P046000.xls" to "P057999.xls".

Cells to extract information from: "C2, I57, I58".

Info to be copied to A2, B2, C2 and so on for 12000 rows, keeping the 3 columns common.

Need help. Please if somebody could help?

Jack

 

[RET79]

I wish you luck.

It would be cool if you could let us know how long that takes you. I am obsessed with the speed of stuff nowadays (sigh)

RET79

 

[Ivan F Moala]

Try this routine;
Notes:

1) Not fully tested.
2) Assumes sheet name = Sheet1
3) Change Dirs as required.<pre/>
Option Base 1

Sub GetValueFromClosedFile_ViaFormula()
Dim sDir As String
Dim ShtCellLoc(3) As String
Dim DataRg As Range
Dim Files
Dim x As Double
'/////////////////////////////////////////////////////////////////
'// Info: /
'// Files :"P046000.xls" to "P057999.xls". /
'// /
'// Cells to extract information from: "C2, I57, I58". /
'// /
'// Info to be copied to A2, B2, C2 and so on for 12000 rows, /
'// keeping the 3 columns common. /
'/////////////////////////////////////////////////////////////////

'// This is the Dir to search in
sDir = "C:analysis"

'// This is the Location/cell address
ShtCellLoc(1) = "Sheet1'!$C$2"
ShtCellLoc(2) = "Sheet1'!$I$57"
ShtCellLoc(3) = "Sheet1'!$I$58"

Files = Dir(sDir & "*.xls")

'// Clear area Column A to place data in
Columns("A:C").Clear

'speed things up
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

x = 2
On Error GoTo FileError
Do While Len(Files) > 0
Cells(x, 1) = "='" & sDir & "[" & Files & "]" & ShtCellLoc(1)
Cells(x, 2) = "='" & sDir & "[" & Files & "]" & ShtCellLoc(2)
Cells(x, 3) = "='" & sDir & "[" & Files & "]" & ShtCellLoc(3)
x = x + 1
Files = Dir()
Loop

'// calculate NOW!!
Application.Calculate

Set DataRg = Range(Range("A2:C2"), Range("A2:C2").End(xlDown))
DataRg.Copy
DataRg.PasteSpecial Paste:=xlValues
Columns("A:C").Columns.EntireColumn.AutoFit
Application.CutCopyMode = False

Set DataRg = Nothing

Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True

MsgBox "Done!...updating complete", vbInformation + vbSystemModal, "Update Status" '64+4096

Exit Sub
FileError:
MsgBox Err.Number & Chr(13) & _
Err.Description & Chr(13) _
, vbCritical + vbMsgBoxHelpButton, _
"File Error", _
Err.HelpFile, _
Err.HelpContext
End Sub</pre>


_________________
Kind Regards,<font size=+2><font color="red"> I<font color="blue">van<font color="red"> F M</font color="blue">oala</font></font></font><A HREF= "http://www.gwds.co.nz/"><font color="green">http://www.gwds.co.nz/excel_files.html - Under Constru
This message was edited by Ivan F Moala on 2002-04-27 17:02

 

[Tom Urtis]

Hey Ivan, this is great...it looks like the basis of your code (aside from reaching all the files in a directory) is a paste link formula in a macro, and PSVing over the formula.

For Jack: you can probably see at least three benefits from Ivan's code --
It bypasses the need for the file to be opened,
It thereby bypasses the prompt to update links,
And the destination cell(s) end(s) up with a value instead of a formula to keep the file size down.

Ivan -- Still working on my web site, mostly because I have a backlog (can't believe it myself !) of Excel projects. Hopefully California's economy is out of the doldrums.

Thanks to all on this thread.

 

[Ivan F Moala]

On 2002-04-27 18:18, Tom Urtis wrote:
Hey Ivan, this is great...it looks like the basis of your code (aside from reaching all the files in a directory) is a paste link formula in a macro, and PSVing over the formula.

For Jack: you can probably see at least three benefits from Ivan's code --
It bypasses the need for the file to be opened,
It thereby bypasses the prompt to update links,
And the destination cell(s) end(s) up with a value instead of a formula to keep the file size down.

Ivan -- Still working on my web site, mostly because I have a backlog (can't believe it myself !) of Excel projects. Hopefully California's economy is out of the doldrums.

Thanks to all on this thread.

Tom thats exactly it.
Let us know when the site is finished.
I'm still a long way off getting my site up.
My assoiate has his side of it done.....
Web page designing, I'm trying to compliment
his side of it with Excel.

All the best

 

[cabala]

Hey Ivan,

That's great man. I will put it to test right away. Just want some update on these codes. They look like working, but i face some problem. The PC hangs the moment i run this code. Might be interferin gwith something. Just let me know on them.

Thankx.
Jack

I can select the particulsr cell from the closed workbook. But i face two problems.

1. I cant' paste them in the new workbook and

2. I cant' loop the files from P046000 to P057999

-------------------------
Sub hastowork()
Dim XL As Excel.Application
Dim WBK As Excel.Workbook
Set XL = CreateObject("Excel.Application")
Set WBK = XL.Workbooks.Open("C:AssignP046001.xls")
WBK.Sheets("pg46.vts").Range("C2").Select
Selection.Copy
WBK.Close
Sheets("sheet1").Select
Range("B1").Select
ActiveSheet.Paste
End Sub
---------------

 

[cabala]

No luck yet guys. The macro simply refuses to work. try whatever i may. Help!!!

Jack

 

[Ivan F Moala]

On 2002-04-29 18:40, cabala wrote:
No luck yet guys. The macro simply refuses to work. try whatever i may. Help!!!

Jack

Jack which macro code refuses to run and
what code is it hanging on....