Macro to sum values from various workbooks if they exist

samchox

New Member
Joined
Feb 2, 2004
Messages
29
Hi,

Im trying to come up with a Macro that will perform a =SUM() function across multiple workbooks. Some of these workbooks may exist, some may not.

For example, Summary.xls has a =sum() formula that picks up data from wbk1.xls
wbk2.xls
wbk3.xls
etc, all the way to 100

Today i only have wbk 1, 2 and 3 but i know everyday more wbk's are added so i want to create a sum type function to accomodate the sbk's that may be created at a future time.

Right now when i try it, I not only get REF/# but on opening Summary.xls I get a popup that asks me to define the missing wbk's

Any suggestions?
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Hi Sam,

You have two (macro) options as I see it:

1. List all of the workbooks that do exist in a column and then use your macro to loop through each cell in the range.

2. Save all of the workbooks in the same directory and then loop through all of the workbooks in that directory.

Number 2 might look something like this:
Code:
Sub OpenAndProcess()
    Dim vaFileName As Variant, wbkData As Workbook, dMySum As Double
    Const MyDir As String = "C:\My Documents\Test"
    'the location of the workbooks
    
    With Application.FileSearch
        .NewSearch
        .LookIn = MyDir
        'the directory to search in
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute > 0 Then
        'workbooks found
            Application.ScreenUpdating = False
            For Each vaFileName In .FoundFiles
            'loop through each found workbook
                Set wbkData = Workbooks.Open(FileName:=vaFileName)
                'open the workbook
                With wbkData
                    With .Worksheets("Sheet1").Range("A1")
                        If IsNumeric(.Value) Then dMySum = dMySum + .Value
                        'add the desired value
                    End With
                    .Close savechanges:=False
                    'close without saving
                End With
            Next vaFileName
            Application.ScreenUpdating = True
            MsgBox "The total is : " & dMySum
        Else
            MsgBox "There were no Excel files found."
        End If
    End With

End Sub
HTH
 
Upvote 0
Thank you Richie! :biggrin:

Instead of a Messagebox with dMySum, can I have dMySum, pasted on a particular cell Summary.xls

Thanx
 
Upvote 0
samchox said:
Thank you Richie! :biggrin:

Instead of a Messagebox with dMySum, can I have dMySum, pasted on a particular cell Summary.xls

Thanx
You're welcome :wink:

Just delete the messagebox line and replace it with something like:
Code:
ThisWorkbook.Worksheets("Sheet1").Range("A1").Value = dMySum
ThisWorkbook refers to the workbook containing the routine (which I assume is Summary.xls). Just change the Sheet1 and A1 parts to reflect the worksheet and cell that you want to contain the value.

HTH
 
Upvote 0
Im back with another couple of questions...

I need to sum cella A20:C45 on each of the wbk.xls files and these are to be pasted in cells A20:C45 on Summary.xls

Also, is there a way to enable macros by default on file open, so that users dont have to click on enable/disable macros

Thanks
 
Upvote 0
I tried copying the above macro and changing the cell range each time so i had some 20 odd macros running one after the other to sum data from the different cells i wanted, but that takes forever, since i have almost 140 files to sift through.

Thanks for helping with this
sam

:cool:
 
Upvote 0
Hi Sam,

OK, this has received limited testing. See if it helps get you started.
Code:
Sub OpenAndProcess()
    Dim vaFileName As Variant, wbkData As Workbook
    Dim vaDataTotal As Variant, vaDataWbk As Variant, lRow As Long, lCol As Long
    Const MyDir As String = "C:\My Documents\Test"
    'the location of the workbooks
    
    With Application.FileSearch
        .NewSearch
        .LookIn = MyDir
        'the directory to search in
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute > 0 Then
        'workbooks found
            Application.ScreenUpdating = False
            ReDim vaDataTotal(1 To 26, 1 To 3) As Variant
            For Each vaFileName In .FoundFiles
            'loop through each found workbook
                Set wbkData = Workbooks.Open(FileName:=vaFileName)
                'open the workbook
                With wbkData
                    vaDataWbk = .Worksheets("Sheet1").Range("A20:C45").Value
                    'get range data into variant (array)
                    For lCol = 1 To 3
                        For lRow = 1 To 26
                            vaDataTotal(lRow, lCol) = _
                                vaDataTotal(lRow, lCol) + vaDataWbk(lRow, lCol)
                        Next lRow
                    Next lCol
                    'add current array values to total array values
                    .Close savechanges:=False
                    'close without saving
                End With
            Next vaFileName
            ThisWorkbook.Worksheets("Sheet1").Range("A20:C45").Value = vaDataTotal
            Application.ScreenUpdating = True
        Else
            MsgBox "There were no Excel files found."
        End If
    End With

End Sub
HTH
 
Upvote 0
This was perfect!

Can I get the wbk's to open in read only cause some of them may be in use when this mcaro is run.

Thanks again for your valuable help.
:pray:


Sam
 
Upvote 0
Hi Sam,

Have a look at the Workbooks.Open method in the Help files. You will see that there is a ReadOnly parameter - set this to True to open the workbook as ReadOnly.

For example:
Code:
Sub Test()
    Workbooks.Open FileName:="ABook.xls", ReadOnly:=True
End Sub
Just amend the relevant line in the code shown above.

HTH
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,541
Latest member
iparraguirre89

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