Sum cells from multiple files in same folder

tripp

New Member
Joined
May 8, 2006
Messages
24
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.
 
Something like this:

Code:
Sub FileHyperlinks()
Dim objFSO As Object, objFolder As Object, objFile As Object, i%, s As Worksheet, p$
p = "C:\cheese project\"
Set s = Sheets("Sheet1")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(p)
i = 1
s.Activate
For Each objFile In objFolder.Files
    If Split(objFile.Name, ".")(1) = "xlsm" Then
        s.Cells(i, 1).Activate
        s.Hyperlinks.Add Selection, objFile.path, , , objFile.Name
        s.Cells(i, 2) = GetValue(p, objFile.Name, "Sheet1", "A1")
        i = i + 1
    End If
Next
End Sub
 
Upvote 0

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Thanks for the reply but it says GetValue is highlighted and there is an error with Sub or a function not defined, couldn't get it to work.

But that's actually not the code snippet I needed help with anyway, it was the first one not listing the output in alphabetical/numerical order. The code below fully works, it just doesn't list the cell data grabbed in order that it scans the folder of files.
This is the code i need help with making it output the data in the right order 0-9/a-z. I think just the Sub Loop needs some adjustment for it to output right?

Code:
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")
    s = "Sheet1"
    a = "A1"
    r = 0
    Do While f <> ""
        r = r + 1
        Range("B" & r) = GetValue(p, f, s, a)
        f = Dir()
    Loop
End Sub
 
Upvote 0
What order means for a sum of numbers is beyond me. Maybe that is "new" math...

The last function can be used if you decide to use the VBA Dir() or fso methods to make an array to sort. Of course the usually Excel sort works fine too.

Code:
'Change p value and 1st input to aFFs() to suit.
Sub Main()
  'https://docs.microsoft.com/en-us/dotnet/visual-basic/programming-guide/language-features/data-types/type-characters
  Dim p$, s$, a$, r&, n, nn, i&, fso As Object
  
  p = ThisWorkbook.path & "\Test"
  s = "Sheet1"
  a = "A1"
  
  n = aFFs(p & "\*.xlsx", "/o:n")  'Order by filename.
  If Not IsArray(n) Then Exit Sub
  ReDim nn(0 To UBound(n))
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  For i = 0 To UBound(n)
    nn(i) = GetValue(p, fso.GetBasename(n(i)), s, a)
  Next i
  Range("B1").Resize(1 + UBound(n)).Value = _
    WorksheetFunction.Transpose(nn)
  Set fso = Nothing
End Sub

'Retrieves a value from a closed workbook
Private Function GetValue(path, file, sheet, ref)
  Dim arg As String
  'path = "d:\files"
  'file = "budget.xls"
  'sheet = "Sheet1"
  'ref = "A1:R30"
     

  'Make sure the file exists
  If Right(path, 1) <> "\" Then path = path & "\"
  If Dir(path & file) = "" Then
    GetValue = CVErr(xlErrNA)
  End If
     
  'Create the argument
  arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
  Range(ref).Range("A1").Address(, , xlR1C1)
   
  'Execute an XLM macro
  GetValue = ExecuteExcel4Macro(arg)
End Function

'Set extraSwitches, e.g. "/ad", to search folders only.
'MyDir should end in a "\" character unless searching by wildcards, e.g. "x:\test\t*
'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
Function aFFs(myDir As String, Optional extraSwitches = "", _
  Optional tfSubFolders As Boolean = False) As Variant
  
  Dim s As String, a() As String, v As Variant
  Dim b() As Variant, i As Long
  
  If tfSubFolders Then
    s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
    Else
    s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
  End If
  
  a() = Split(s, vbCrLf)
  If UBound(a) = -1 Then
    Debug.Print myDir & " not found.", vbCritical, "Macro Ending"
    Exit Function
  End If
  ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr
  
  For i = 0 To UBound(a)
    If Not tfSubFolders Then
      s = Left$(myDir, InStrRev(myDir, "\"))
      'add the folder name
      a(i) = s & a(i)
    End If
  Next i
  aFFs = sA1dtovA1d(a)
End Function

Function sA1dtovA1d(strArray() As String) As Variant
  Dim varArray() As Variant, i As Long
  ReDim varArray(LBound(strArray) To UBound(strArray))
  For i = LBound(strArray) To UBound(strArray)
    varArray(i) = CVar(strArray(i))
  Next i
  sA1dtovA1d = varArray()
End Function

'http://www.vbaexpress.com/forum/showthread.php?48491
Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
    With CreateObject("System.Collections.ArrayList")
        Dim cl As Variant
        For Each cl In sn
            .Add cl
        Next
         
        .Sort 'Sort ascendending
        If bAscending = False Then .Reverse 'Sort and then Reverse to sort descending
        ArrayListSort = .Toarray()
    End With
End Function
 
Last edited:
Upvote 0
Thanks Kenneth, It looks a lot more involved than what i had to start with, I'll review that when i get home.
So that is just taking a single cell from each worksheet in a given folder and making a column list of that data in the new excel doc with this code right?

which part of the code do i modify if i want to grab lets say 6-7 different cells from 2 different sheets within those excel docs? I'll need to either copy the Sub loop or add some variables to also grab those extra individual cells?
 
Upvote 0
Actually just to paint a better picture of what I'm doing, this is what I am trying to achieve exactly. Every excel doc in a given folder has these pages and data i need to grab from these cells.

from sheet2 "Enter Info"
C18 and put it in the B column
C3 and put it in the C column
C13 and put it in the D column
C19 and put it in the E column

from sheet1 "Item Work Sheet"
N5 and put it in the F column
F2 and put it in the G column
N4 and put it in the H column
P4 and put it in the I column

I then output it to those columns in the new excel doc, I also need to be able to control the offset of where the data starts to be entered, because i'll probably start it on row 2 because i have it in a formatted Table which takes up Row 1 with names.
Hope this helps to see what i'm ultimately going for.

I did this before with the code i posted above by just adding the Sub Loop over and over again with the different data fields i have above. (It probably could have been all within the same loop maybe but didn't want to mess it up because I'm not the best programmer and what I did worked fine enough.) Then i just did Call LoopThruBooks, Call LoopThruBooks1, Call LoopThruBooks2, Call LoopThruBooks3 etc..
 
Last edited:
Upvote 0
The VBA Dir() method is fine for a single folder. FSO method is fine too. I have not confirmed that the 2 methods return the same "order". I suspect that they do. Both methods can sort after the fact using array methods or Excel worksheet's sort. Of course you have to be creative to sort by modification date, creation date, file size, etc. I have used a recursive fso method for subfolder iteration but my method has always been faster for me. The concept for the method that I used goes back to DOS days but it is very fast and very robust. See the comment to see the help for the options it can do. I built it after FileSearch was removed. I do batch routines often.

So, once you understand the routines, they can reused easily. I call it my bag of tricks. Don't let seemingly long code bother you. Those often contain features and error catching routines and likely speed routines that some others may not have.

You have expanded the scope of what you asked. It would be best to start your own thread. You can always add a link to this one if needed.

Obviously, the one file per one value per one cell written is not going to do it for you. A Range Offset will likely be needed. It depends on what are doing though. Is it 2 sheets and 7 cells per file or? It is all about logistics of course. The Excel4 method is very unforgiving. e.g. Someone renames Sheet1. There is only one sheet in a file. Sometimes, an ADO method is a better choice. While it can be coded to avoid some of the Excel4 problems, it can cause other problems but generally gives you more power.
 
Upvote 0
Thanks for the reply but it says GetValue is highlighted and there is an error with Sub or a function not defined, couldn't get it to work.

o To see that example working, paste the Get Value function on the module. Note that the data on both columns will match each other. This range can be sorted if necessary.
o I will be back tomorrow with something specific to post #25 .
 
Last edited:
Upvote 0
Updated example, tell me if you do not understand how it works:

Code:
Sub FileData()
Dim objFSO As Object, objFolder As Object, objFile As Object, i%, p$, r%, ei, iw
p = "C:\pub\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(p)
r = 2
ei = Array("c18", "c3", "c13", "c19")
iw = Array("n5", "f2", "n4", "p4")
For Each objFile In objFolder.Files
    If Split(objFile.Name, ".")(1) = "xlsm" Then
        For i = LBound(ei) To UBound(ei)
            ActiveSheet.Cells(r, 2 + i) = GetValue(p, objFile.Name, "enter info", ei(i))
        Next
        For i = LBound(iw) To UBound(iw)
            ActiveSheet.Cells(r, 6 + i) = GetValue(p, objFile.Name, "item work sheet", iw(i))
        Next
        r = r + 1
    End If
Next
SortRange
End Sub


Sub SortRange()
Dim s As Worksheet
Set s = ActiveSheet
s.Sort.SortFields.Clear
s.Sort.SortFields.Add [b2], xlSortOnValues, xlAscending, , 0
With s.Sort
    .SetRange [b2].CurrentRegion
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = 1
    .Apply
End With
End Sub
 
Upvote 0
As I said before, do not forget to paste the Get Value function on the module.
 
Upvote 0

Forum statistics

Threads
1,223,239
Messages
6,170,947
Members
452,368
Latest member
jayp2104

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top