Solved

Summarization of the cells with same position into a summary file with VBA

Posted on 2011-03-22
14
321 Views
Last Modified: 2012-05-11
Hi,

PLEASE HELP. I am new to VBA and was trying this code to get around a problem. I have nearly 20 workbooks that contain 23 sheets each. I have prepared a code in a separate "Summary" workbook that should work in a way that it goes and searches for a specific range in those 20 workbooks and the subsheets and sums values cell by cell in this range. I have come up with a code that works for 1 cell but cannot get it working on a range nor in multiple sheets. For illustration please see how the files look like. The summary sheet looks just like the sample but does not have the 1s in - it's empty for the summarization. Any help with the code to get it working on a range and on multiple sheets will be welcome! If any clarification is needed I will be of help! Thanks in advance!
PS: the macro is available in the sample sheet as well Sample.xlsm
Sub Summary()

'Summarization macro - is searching for a specific cell in every workbook in the folder and sums it up in a predefined cell

Dim wb As Workbook, TheFile As String
Dim MyPath As String, TheSum As Double
Dim MyArray As Variant
MyArray = Array("CLOOS-1323.003", "CLOOS-1324.004", "CLOOS-1325.005")
TheSum = 0
MyPath = ThisWorkbook.Path
ChDir MyPath
TheFile = Dir("*.xlsx")
Do While TheFile <> ""
If TheFile <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
TheSum = TheSum + Sheets("1630.001 Montáž koles.jednot.").Range("G12:028")
wb.Close
End If
TheFile = Dir
Loop
Sheets(MyArray).Range("G12:028") = TheSum
End Sub

Open in new window

0
Comment
Question by:lejohney
  • 9
  • 2
  • 2
14 Comments
 
LVL 41

Accepted Solution

by:
dlmille earned 334 total points
ID: 35194987
ok.  I modified your code on these assumptions:

The worksheets were as specified in MyArray (I had to change the text to match the ACTUAL tab names in the sample.xlsm file, as there were extra spaces in places).

We iterate through each workbook in the directory, opening the file, then for each worksheet in the MyArray() list, we copy/paste with add operation onto the summary worksheet.

See code below, and attached file.
 
Sub Summary()

'Summarization macro - is searching for a specific cell in every workbook in the folder and sums it up in a predefined cell

Dim wb As Workbook, TheFile As String
Dim MyPath As String
Dim MyArray() As String
'Dim MyArray As Variant
Dim myCopyRange As String
Dim i As Integer

    'MyArray = Array("CLOOS -1323.003", "CLOOS -1324.004 ", "CLOOS -1325.005 ") ' assumes all workbooks have these sheet names.  Note this name string was corrected based on the sample spreadsheet
    i = 0
    For Each mysheet In ActiveWorkbook.Sheets 'build myArray based on sheets in this summary workbook
        ReDim Preserve MyArray(i) As String
        MyArray(i) = mysheet.Name
        i = i + 1
    Next mysheet
    
    myCopyRange = "G12:O28"
    
    For i = LBound(MyArray) To UBound(MyArray) 'loop through each sheet to be summed based on the sum range, setting initial values to zero
        
        ThisWorkbook.Sheets(MyArray(i)).Range(myCopyRange).Value = ""
        
    Next i

    MyPath = ThisWorkbook.Path
    ChDir MyPath
    TheFile = Dir("*.xlsx")
    
    Do While TheFile <> ""
        If TheFile <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(MyPath & "\" & TheFile)
            For i = LBound(MyArray) To UBound(MyArray) 'loop through each sheet to be summed based on the sum range
                'pull range G12:O28 from SOURCE sheet into DESTINATION sheet, adding as we go...  do this in a loop, adding cell by cell
                '
                'The commented section here, adds the ranges cell by cell - there's a better alternative
                'For Each myCell In ThisWorkbook.Sheets(MyArray(i)).Range(myCopyRange)
                '    myCell.Value = myCell.Value + wb.Sheets(MyArray(i)).Range(myCell.Address).Value 'so add cell by cell, the same range, in the same sheet name
                '    If myCell.Value = 0 Then myCell.Value = "" 'if no values were copied over, then leave the cell blank
                'Next myCell
                
                'The better alternative, is to copy/paste with the add operation.  We can select the entire range in copy, then paste on the summary workbook with the add operation
                
                'first copy from the SOURCE worksheet
                wb.Sheets(MyArray(i)).Range(myCopyRange).Copy
                
                'then paste with the add operation
                ThisWorkbook.Sheets(MyArray(i)).Range(myCopyRange).PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
                Application.CutCopyMode = False 'clear the clipboard
                
            Next i
            wb.Close
        End If
        TheFile = Dir
    Loop
    
End Sub

Open in new window

If ALL THE TABS in the Summary workbook are the tabs to pull from SOURCE sheets, you can loop through the worksheets as well, as opposed to creating myArray.  I've added this "feature" - or you can delete this particular code and revert.

Enjoy!

Dave
Sample-r1.xlsm
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35194996
To test the above post, I created .xlsx copies of the sample file in a separate directory with the sample-r1.xlsm file.  When it ran, it worked very quickly.

Cheers,

Dave
0
 
LVL 45

Assisted Solution

by:aikimark
aikimark earned 166 total points
ID: 35195057
posting code from other thread.

Option Explicit

Sub Summary()

'Summarization macro - is searching for a specific cell in every workbook in the folder and sums it up in a predefined cell

  Dim wb As Workbook, TheFile As String, MyArray() As Variant
  Dim MyPath As String, TheSum As Double
  Dim M As Range, wksThing As Worksheet
  Dim vThisSheetData As Variant, vSheetSumData() As Long
  MyArray = Array("CLOOS -1323.003", "CLOOS -1324.004 ", "CLOOS -1325.005 ")  '<-- changed  to match uploaded file worksheet names
  Dim lngIndex As Long, dicSheetNames As Object
  Dim lngRow As Long, lngCol As Long, boolFound As Boolean
  Set dicSheetNames = CreateObject("Scripting.Dictionary")
  ReDim vSheetSumData(1 To 23, 1 To 30, LBound(MyArray) To UBound(MyArray))
  For lngIndex = LBound(MyArray) To UBound(MyArray)
    dicSheetNames.Add MyArray(lngIndex), lngIndex
  Next
  
  MyPath = ThisWorkbook.Path
  
  TheFile = Dir("*.xlsm")  '<-- changed for testing
  Do While Len(TheFile) <> 0
    If TheFile <> ThisWorkbook.Name Then
      Set wb = Workbooks.Open(MyPath & "\" & TheFile, False, True)
      For Each wksThing In wb.Worksheets
        If dicSheetNames.Exists(wksThing.Name) Then
          lngIndex = dicSheetNames(wksThing.Name)
          vThisSheetData = wksThing.Range("D12:AG34").Value
          For lngRow = LBound(vThisSheetData, 1) To UBound(vThisSheetData, 1)
            For lngCol = LBound(vThisSheetData, 2) To UBound(vThisSheetData, 2)
              vSheetSumData(lngRow, lngCol, lngIndex) = vSheetSumData(lngRow, lngCol, lngIndex) + vThisSheetData(lngRow, lngCol)
            Next
          Next
        
        End If
      Next
      wb.Close
    End If
    TheFile = Dir
  Loop
  
  For lngIndex = LBound(MyArray) To UBound(MyArray)
    For lngRow = LBound(vSheetSumData, 1) To UBound(vSheetSumData, 1)
      For lngCol = LBound(vSheetSumData, 2) To UBound(vSheetSumData, 2)
        vThisSheetData(lngRow, lngCol) = vSheetSumData(lngRow, lngCol, lngIndex)
      Next
    Next
    Worksheets(MyArray(lngIndex)).Range("D12:AG34").Value = vThisSheetData
  Next
End Sub

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
ID: 35195229
What - did two of us spend time updating the same question from two different threads?

Dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35195249
lejohney, please ensure you see my post (first one on this question).

http:#35194987 , above

Cheers,

Dave

fixed link -- aikimark (ZA)

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
ID: 35195250
Forget that link - I keep forgetting how to address a post - anyway, its the first post on this question.

Enjoy!

Dave
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 41

Expert Comment

by:dlmille
ID: 35195421
@aikimark - quid pro quo?  Are you going to paste my solution in the other question as well?

Thanks!

Dave
0
 
LVL 45

Expert Comment

by:aikimark
ID: 35195507
@Dave

I'm waiting to hear from lejohney before I do anything else.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35195508
Ok - thanks.
0
 

Author Comment

by:lejohney
ID: 35196552
Hello guys!
Thank you much for your tremendous effort. I am sorry for creating duplicates - my bad, although I was trying many different approaches.
For the code dlmille provided:
I tried to run it but I get an out of range notice for

wb.Sheets(MyArray(i)).Range(myCopyRange).Copy

To better ilustrate the whole problem:
The sheets in the sample file represent "a picture of working day" in an industrial production. The data are provided per each station based on the type of work that was recorded at given times. I have 25 workbooks each containing 25 different sheets (representing workstations - the sample carries only 3 out of 25). Now I have put all of them in the same folder and want the code to loop through the sheets (which are always in the same order) and retrieve the data per each workbook and worksheet and sum it up in a summary master that is of the same layout.

Therefore I do not know whether the code that was provided here does the work, I've been getting unprecise numbers and that might be also b/c the code needs to debug due to above mentioned notice.

Could you please advice now how to improve it!
I am learning a lot thanks to you guys!
Very much appreciated.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35196811
This is what the code I provided is designed to do.  It will loop through and open all files, then for each sheet that's in the Master (Called Sample-r1.xlsm), it copies and pastes (with the add option) from the files in the folders, to the worksheet in the summary master...

what is this "out of range notice" exactly?  Can you describe this more fully?

it could possibly be that the SOURCE workbook does NOT have a tab with the EXACT name that exists in the Master summary.

Would you kindly create a subdirectory with the master sample workbook I posted, and ONE of your SOURCE sheets.

Then, please VERIFY that the 3 tabs in the master summary worksheet exist in the SOURCE sheet and the names of the tabs are EXACTLY the same.

-------

You could also upload ONE of your SOURCE workbooks for me to look at, please - feel free to delete all the data - I just want to look at the spreadsheet structure (specifically, tab names).

Cheers,

Dave
0
 
LVL 41

Assisted Solution

by:dlmille
dlmille earned 334 total points
ID: 35196910
lejohney - I've tested this with lots and lots of spreadsheets.  It does work.  If you can upload ONE sample source sheet - fake or delete the data, I can debug quickly.  I'm suspecting the tab names may not be matching, so I can help you check that...

I'm here for a short while, then off to bed - if you can send shortly, I'll give it my full attention so you can get your solution... :)

Dave
0
 

Author Comment

by:lejohney
ID: 35196940
Sorry guys, got it working already! Thank you all for the support!
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now