Sum data from multiple closed workbooks based on multiple criteria in XL10

MadaSchmidt

New Member
Joined
Aug 21, 2015
Messages
5
Long story short I have 153 identically formatted .xlsx files which multiple people enter data into. I am creating a 'master report' workbook that needs to pull that data and combine the totals from those sheets.

I'm using excel 2010 on a windows 7 enterprise machine.

The source workbooks have two sheets each, one named matching part of the filename (filenames are 'ABCD 1234.xlsx' and the sheet matches the 1234 of the filename) and one named 'REPORT'.
The source sheets ('REPORT') are laid out as follows:
Three header rows
Column A contains dates from 15 Jan 2015 to 31 Dec 2016 (A4:A720) formatted as DD/MM/YYYY
Column B has weekdays as "MON", "TUE", "WED", "THU", "FRI", "SAT", "SUN" matching the dates (B4:B720)
Columns C:Q and AP:AS have formulas counting data in a second sheet in each workbook based on various criteria. Data is displayed with 'General' format as whole numbers.
Columns R:AO have manually entered whole numbers (number of minutes)

What I need to accomplish on my master report is the following:
Automatically add up the values found in the columns of the 153 'REPORT' worksheets corresponding to their dates.
i.e. for 15/01/2015 add up values of 'REPORT'!$C$4 of book1, book2, book3, book4...book153 and display next to 15/01/2015 in 'MasterReport'!$D$2 (for example) and do the same for 'REPORT'!D:AS.
The master report has a similar layout as the individual reports, but is not identical.
It would be ideal if the module were linked to a button on the master report sheet to trigger the function rather than automatically running it every time the report is opened as it may need to be viewed without updating every time.

I have tried to do this with formulas, but it seems that excel or my laptop do not have sufficient resources to calculate all those formulas, (not to mention typing 153 file location references into a single formula isn't possible as it exceeds Excel's character limit of 8192) so I'm hoping there is a reasonably simple solution using VBA.

I was using =SUMPRODUCT() functions and that seemed to work, but with 153 different source sheets to draw from it just wasn't practical.

The source workbook filenames are 'ABCD 1234.xlsx' where ABCD is the same for all of them, but 1234 is different and they are all stored in the same folder. The master report file is also stored in the same directory.

Any help here would be much appreciated as I've already lost a week trying to figure this out with formulas... :)

Thanks in advance
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Over the weekend I did some more digging and came up with a partially successful bit of code, however, it is extremely long (because I have so many workbooks to draw from) and it takes forever to run because it is opening all the workbooks, copying and summing the data and then closing all the workbooks.
How would I modify my existing code to:
a. be more concise
b. run without opening all the workbooks

Here's the code I've come up with so far just testing it on the first three workbooks and then I'll extrapolate to the rest:
Sub consolidateData()
Dim Path As String
Path = "S:\Directory where my workbooks are\"

Application.ScreenUpdating = False

Range("E2").Select
Workbooks.Open Filename:="" & Path & "ABCD 0101.xlsx"
Workbooks.Open Filename:="" & Path & "ABCD 0102.xlsx"
Workbooks.Open Filename:="" & Path & "ABCD 0103.xlsx"
Workbooks.Open Filename:...

Windows("zz_master_report").Activate

Selection.Consolidate Sources:=Array( _
"'" & Path & "[ABCD 0101.xlsx]REPORT'!R4C6:R720C6", _
"'" & Path & "[ABCD 0102.xlsx]REPORT'!R4C6:R720C6", _
"'" & Path & "[ABCD 0103.xlsx]REPORT'!R4C6:R720C6" _
), Function:=xlSum

Windows("ABCD 0101.xlsx").Activate
ActiveWorkbook.Close
Windows("ABCD 0102.xlsx").Activate
ActiveWorkbook.Close
Windows("ABCD 0103.xlsx").Activate
ActiveWorkbook.Close

End Sub


Thanks
 
Upvote 0
I've rethought this whole problem some more. I think it will be easier if I can just copy the last 7 days' worth of data rather than the entire worksheet every time.

As I mentioned in my original post all the 153 sheets are identical and column A contains a date starting on 15/1/15 and ending on 31/12/16. I want to 'run a report' on a weekly basis that updates a summary worksheet with the figures from the 153 worksheets from the past week.

Nearest I can figure this is the logic I'm looking for, I'm just not sure how to make it work with VBA:
Search source sheet for rows containing dates between 'Date - 6' and 'Date'
Extract data in resulting rows and sum with previous results (ie. all 153 sheets)
Paste resulting total into corresponding rows of summary sheet

I've been able to get a loop working that copies the dates into a new worksheet, but that's about it... :(
Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range

Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
FolderPath = "folder location of all the worksheets"
NRow = 1
FileName = Dir(FolderPath & "ABCD *.xlsx")
Do While FileName <> ""
Set WorkBk = Workbooks.Open(FolderPath & FileName)
Dim Sh As Worksheet: Set Sh = Sheets("REPORT")
Dim i, j As Integer
LookupColumn = "A"
StartDate_Value = DateAdd("d", -6, Date)
EndDate_Value = Date
For i = 1 To 30000
If Sh.Range(LookupColumn & i).Value = EndDate_Value Then EndDate_Row = i
Next i
For j = EndDate_Row To 1 Step -1
If Sh.Range(LookupColumn & j).Value = StartDate_Value Then StartDate_Row = j
Next j
Set SourceRange = Sh.Range(LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row)
Set DestRange = Range("C" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
DestRange.Value = SourceRange.Value
NRow = NRow + DestRange.Rows.Count
WorkBk.Close savechanges:=False
FileName = Dir()
Loop
SummarySheet.Columns.AutoFit
End Sub
 
Upvote 0
I think I'm actually getting close to what I'm trying to do. Can anyone tell me if I'm at least on the right track with this?

** the array only has 10 workbooks referenced for now. I'll add the others once I get this to work...

Sub ConsolidateWorkbooks()
Dim WBArray As Variant
Dim path As String
path = "C:\folder with all the worksheets\"

Dim Sh As Worksheet: Set Sh = Sheets("Sheet1")
Dim i, j As Integer
LookupColumn = "A"
StartDate_Value = DateAdd("d", -6, Date)
EndDate_Value = Date
For i = 1 To 30000
If Sh.Range(LookupColumn & i).Value = EndDate_Value Then EndDate_Row = i
Next i
For j = EndDate_Row To 1 Step -1
If Sh.Range(LookupColumn & j).Value = StartDate_Value Then StartDate_Row = j
Next j
Dim MyDateRange As Range: Set MyDateRange = Sh.Range(LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row)

'WBArray = Array( _
'"" & path & "[ABCD 0101.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "", "" & path & "[ABCD 0102.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "", "" & path & "[ABCD 0103.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "", "" & path & "[ABCD 0104.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "", "" & path & "[ABCD 0105.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "", "" & path & "[ABCD 0106.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "", "" & path & "[ABCD 0107.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "", "" & path & "[ABCD 0108.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "", "" & path & "[ABCD 0109.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "", "" & path & "[ABCD 0110.xlsx]!" & MyDateRange.Address(ReferenceStyle:=xlR1C1) & "")

Worksheets("Sheet1").Range(MyDateRange).Consolidate Sources:=Array(WBArray), Function:=xlSum
End Sub
 
Upvote 0
Well I've pretty much figured it out...finally...

Sub ConsolidateWorkbooks()
Dim WBArray(152) As String
Dim path As String
path = "FOLDER LOCATION OF ALL WORKSHEETS"
Dim Sh As Worksheet: Set Sh = Sheets("Sheet1")
Dim i, j As Integer
LookupColumn = "A"
StartDate_Value = DateAdd("d", -2, Date)
EndDate_Value = Date
For i = 1 To 30000
If Sh.Range(LookupColumn & i).Value = EndDate_Value Then EndDate_Row = i
Next i
For j = EndDate_Row To 1 Step -1
If Sh.Range(LookupColumn & j).Value = StartDate_Value Then StartDate_Row = j
Next j
Dim MyDateRange As Range: Set MyDateRange = Sh.Range(LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row)
'MsgBox "MyDateRange = " & LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row
Dim MyDataRange As Range: Set MyDataRange = Sh.Range(MyDateRange.Address).Offset(, 2).Resize(, 40)
'MsgBox MyDataRange.Address
WBArray(0) = path & "[ABCD 0101.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)
WBArray(1) = path & "[ABCD 0102.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)
WBArray(2) = path & "[ABCD 0103.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)
WBArray(3) = path & "[ABCD 0104.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)
WBArray(4) = path & "[ABCD 0105.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)
WBArray(5) = path & "[ABCD 0106.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)
WBArray(6) = path & "[ABCD 0107.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)
WBArray(7) = path & "[ABCD 0108.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)
WBArray(8) = path & "[ABCD 0109.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)
WBArray(9) = path & "[ABCD 0110.xlsx]REPORT!" & MyDataRange.Address(ReferenceStyle:=xlR1C1)

Worksheets(1).Range(MyDataRange.Address).Consolidate Sources:=Array(WBArray(0), WBArray(1), WBArray(2), WBArray(3), WBArray(4), WBArray(5), WBArray(6), WBArray(7), WBArray(8), WBArray(9)), Function:=xlSum

End Sub

Now the problem I have is that for some reason when I run the code on another computer with the same permissions it gives me a 1004 error.
What gives?

Thanks
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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