Sum cells from multiple files in same folder

[tripp]

I have multiple excel files (file number varies but now it's approx 30) in one folder location. All of the files are formatted exactly the same. Only the file names and cell contents differ.
Is there is a way to sum (or get) the values of the same cell and/or range in all of the files into a new excel file worksheet?

Example: Sum or get value in cell "A1" from Sheet1 of all files in C:\excelfolder.
and
Sum or get values in range "A1:B2" from Sheet1 from all files in C:\excelfolder.

Thanks for any assistance.

 

[Warship]

Have a look at:
http://spreadsheetpage.com/index.php/tip/a_vba_function_to_get_a_value_from_a_closed_file/

 

[tripp]

HTH,
Thanks for the quick reply. I'm looking at it now. I apologize for my ignorance. Which or all of the examples should I use? Copy and paste in sheet, workbook, form, or module? Thanks again!

 

[Warship]

Let me wrap my head around your specifics and post back.

(P.S. "HTH" = "Hope this helps")

 

[VoG]

This may also help http://msdn.microsoft.com/en-us/library/cc837974.aspx

 

[tripp]

Warship & VoG
Very steep learning curve on my part...but surprisingly fun none-the-less. I very much appreciate any and all suggestions and will attempt to explain the resolution (should I figure it out).

Let me clarify a little as far as what I would "like to have" with the get function...

Get value in cell "A1" from Sheet1 of .xls file in C:\excelfolder and place in cell "A1" of active sheet.

Get value in cell "A1" from Sheet1 from next .xls file in C:\excelfolder and place in "A2" of active sheet.

Continue so on and so on until the value of "A1" has have been retrived from all .xls files in C:\excelfolder and placed in active sheet's "A" coulmn...A1, A2, A3, A4...

 

[Warship]

Place in Std Module and Call LoopThruBooks

Private Function GetValue(path, file, sheet, ref)
    Dim arg As String
    If Right(path, 1) <> "\" Then path = path & "\"
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
      Range(ref).Range("A1").Address(, , xlR1C1)
    GetValue = ExecuteExcel4Macro(arg)
End Function

Sub LoopThruBooks()
    Dim p, f, s, a, r
    p = "C:\excelfolder\"
    f = Dir(p & "*.xls")
    Do While f <> ""
        s = "Sheet1"
        a = "A1"
        r = r + 1
        Range("A" & r) = GetValue(p, f, s, a)
        f = Dir()
    Loop
End Sub

 

[Warship]

"s" & "a" didn't need to be in the loop.

Sub LoopThruBooks()
    Dim p, f, s, a, r
    p = "C:\excelfolder\"
    f = Dir(p & "*.xls")
    s = "Sheet1"
    a = "A1"
    Do While f <> ""
        r = r + 1
        Range("A" & r) = GetValue(p, f, s, a)
        f = Dir()
    Loop
End Sub

 

[Kenneth Hobson]

Same method as Warship's code:

Sub DirFiles()
    Dim FileName As String, FileSpec As String, FileFolder As String
    Dim wb As Workbook
    Dim dblSum As Double, fn As String
    
    dblSum = 0
     
    FileFolder = ThisWorkbook.path
    FileSpec = FileFolder & "\test*.*"
     
    FileName = Dir(FileSpec)
    If FileName = "" Then Exit Sub
     
     '   Loop until no more matching files are found
    Do While FileName <> ""
        If IsWorkbookOpen(FileName) = False Then
            'Set wb = Workbooks.Add(FileFolder & FileName)
            'DoEvents
            dblSum = dblSum + (GetInfoFromClosedFile(FileFolder, FileName, "Sheet1", "A1"))
            'wb.Close True
        End If
        FileName = Dir()
    Loop
    
    MsgBox dblSum
End Sub
 
Function IsWorkbookOpen(stName As String) As Boolean
    Dim Wkb As Workbook
    On Error Resume Next ' In Case it isn't Open
    Set Wkb = Workbooks(stName)
    If Not Wkb Is Nothing Then IsWorkbookOpen = True
     'Boolean Function assumed To be False unless Set To True
End Function

'=GetValue("c:\files", "budget.xls", "Sheet1", "A1")
'    wbPath = "d:\files"
'    wbName = "budget.xls"
'    wsName = "Sheet1"
'    cellRef = "A1:R30"
Private Function GetInfoFromClosedFile(ByVal wbPath As String, wbName As String, wsName As String, cellRef As String) As Variant
    Dim arg As String
    GetInfoFromClosedFile = ""
    If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
    If Not FileExists(wbPath & "\" & wbName) Then Exit Function
    arg = "'" & wbPath & "[" & wbName & "]" & wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
    On Error Resume Next
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function

Function FileExists(sFilename As String) As Boolean
  Dim fso As Object, tf As Boolean
  Set fso = CreateObject("Scripting.FileSystemObject")
  tf = fso.FileExists(sFilename)
  Set fso = Nothing
  FileExists = tf
End Function

 

[hawkzeng]

I found this page when I Google the same problem, it works for me, and thanks a lot, Warship.

Just want to highlight, to get the code works, the name of worksheet in the active workbook should be the same as multi-files. In this case, It should be named as "Sheet1". (I am very new to VBA, not sure if this is a obvious thing in VBA world, :P).

I have two extra questions to ask:

1. Is that possible to pull out from different cell in the same worksheet? In the case, only value in A1 in multi-files are pulled to column A of the active worksheet, what if I wish to pull B1 at the same time to column B?

2. What sequence the VBA code used to handle multi-files (pulling sequence)? In my case, I pull "date" data from multi-files, and I found that the arrangement of pulling result is not aligned with the file name from A to Z.

Appreciate for your kindly help!

Regards,
ZM

Place in Std Module and Call LoopThruBooks

Private Function GetValue(path, file, sheet, ref)
    Dim arg As String
    If Right(path, 1) <> "\" Then path = path & "\"
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
      Range(ref).Range("A1").Address(, , xlR1C1)
    GetValue = ExecuteExcel4Macro(arg)
End Function

Sub LoopThruBooks()
    Dim p, f, s, a, r
    p = "C:\excelfolder\"
    f = Dir(p & "*.xls")
    Do While f <> ""
        s = "Sheet1"
        a = "A1"
        r = r + 1
        Range("A" & r) = GetValue(p, f, s, a)
        f = Dir()
    Loop
End Sub