Pull values from many Excel files
Posted by RT on August 17, 2001 11:49 AM
How can one value be pulled from a predefined cell from each of many spreadsheets? I have a folder that contains as many as 50 Excel files which represent the current week's invoices. The file names are different each week. I want to make a table of the total invoice amount from each file. My main difficulty is in using a macro to open each file in sequence without having a list of the file names prepared in the spreadsheet running the macro.
Posted by Damon Ostrander on August 17, 2001 9:55 PM
Hello RT,
The VBA Dir function should help with this. It enables one to return the names of all the files in a folder or directory tree, one at a time. Dir supports wildcards, so you could for example only return file names containing the substring "invoice". Dir normally reads the names in alphabetical order, so if you want to sort these names in a particular order, you could use Dir to read the names to a worksheet, do a sort in VBA, then loop through these files in this order, opening each one, pulling the values you need, and closing it. Excel still has to open and close 50 files, but would probably complete the job while you got a cup of coffee.
Damon
PS. There's a pretty good example of the use of the Dir function in the VBA helps.
Posted by Ivan F Moala on August 17, 2001 10:51 PM
Hi RT
here is a way to get the info by not openning
the workbooks so should be fairly fast.
Obviously you will have to amend where you need.
Notes:
1) Assumes just ONE cell location to get
you may need more ??
2) Change Dir as required + Sheet name and address
Sub GetValue_ViaFormula()
Dim sDir As String
Dim ShtCellLoc As String
Dim DRg As Range
Dim Files
Dim x As Double
'This is the Dir to search in
sDir = "C:\Excelfiles\"
'This is the Location/cell address
ShtCellLoc = "Sheet1'!$A$1"
Files = Dir(sDir & "*.XLS")
'Clear area Column A to place data in
'Change this as required
Columns("A:A").Clear
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = 1
On Error GoTo FileError
Do While Len(Files) > 0
Cells(x, 1) = "='" & sDir & "[" & Files & "]" & ShtCellLoc
x = x + 1
Files = Dir()
Loop
Set DRg = Range(Range("A1"), Range("A1").End(xlDown)) '.Copy
DRg.Copy
DRg.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit
Application.CutCopyMode = False
Set DRg = Nothing
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True
MsgBox "Done!"
Exit Sub
FileError:
MsgBox Err.Number & Chr(13) & _
Err.Description & Chr(13) _
, vbCritical + vbMsgBoxHelpButton, _
"File Error", _
Err.HelpFile, _
Err.HelpContext
End Sub
