Solved

Excel 2007 Macro To Aggregate Multiple Worksheet Totals

Posted on 2014-10-03
9
290 Views
Last Modified: 2014-10-31
Hello,

Hoping someone can assist in developing a macro that will look at multiple worksheets and aggregate column data into a Summary worksheet.  Sample attached.  Please note that the order the evaluator names are in can differ from worksheet to worksheet and there might be a name on one that does not appear in the others.  I've included 3 individual worksheets and a summary page but in the real report will have about 24 worksheets that need to be aggregated so hoping that it will be easy for me to go into the code and add the additional worksheets.

Thank you!
EE-Example.xlsx
0
Comment
Question by:Escanaba
  • 3
  • 3
  • 3
9 Comments
 
LVL 26

Expert Comment

by:ProfessorJimJam
ID: 40359696
see attached file. run the macro called  CopyRangeFromMultiWorksheets

it will combine all the worksheets into the summary worksheet.
EE-Example.xlsm
0
 
LVL 1

Author Comment

by:Escanaba
ID: 40359728
Thank you for the quick response.  I tested your macro and I think you're close.  Is there a way to set it up so that instead of repeating the data there is only one instance of the evaluator name and their totals aggregated for all worksheets?  For example, instead of having 3 individual George Washington's there would be only one and his total average score would be the aggregate of all three worksheets (17.75).
0
 
LVL 26

Expert Comment

by:ProfessorJimJam
ID: 40359738
is your other sheets are always 6 columns? i mean from A to F?
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 26

Expert Comment

by:ProfessorJimJam
ID: 40359744
does it have to be VBA ? or formula with using Indirect can be acceptable?   is all of your source sheets names are identical like Q_3.a.DEV , then b , c , e , f ,g ,h and so on.

i would try to come up with somthing, but if it has to  be vba then, there are very smart gurus in this forum that can do that in a blink. lets see
0
 
LVL 1

Author Comment

by:Escanaba
ID: 40359761
Yes - Always A - F
Yes - Source sheet names are identical starting at Q_3.b.DEV and ending at Q_5.d.DEV but there is always the potential for new source files down the road

There is already an existing VBA that takes the raw data which is a complete mess and restructures it so my reporting software can actually use it.  I was hoping this new VBA code would be a companion piece that I could add in for a summary sheet.
0
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 40360710
Hello again.  This code will create a summary sheet showing the totals of the scores in columns B, C, and D on each sheet for each unique evaluator.  It will sort the results by evaluator name.

This subroutine could be added to an existing module and could be called at the end of existing code simply by adding
Summarize_Scores

Open in new window

near the end of your current sheet-building code (which I seem to recall... :-)   )
Option Explicit
Sub Summarize_Scores()
    Dim arrEval(), arrScores(100, 4) As Variant
    Dim ev, r, sh, x As Integer
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Sheets("Summary").Delete
    
    Sheets.Add before:=Sheets(1)
    ActiveSheet.Name = "Summary"
    Range("A1").Value = "Evaluator Name"
    Range("B1").Value = "Total Score"
    Range("C1").Value = "Total Organizational Score"
    Range("D1").Value = "Total No. of Evaluations"
    Range("A2").Select
    
    'Create list of evaluators
    r = 2
    For sh = 2 To Sheets.Count
        x = 2
        Do Until Sheets(sh).Cells(x, 1).Value = ""
            Cells(r, 1).Value = Sheets(sh).Cells(x, 1).Value
            r = r + 1
            x = x + 1
        Loop
    Next sh
    
    'remove duplicates and assign evaluator names to array
    ActiveSheet.Range("A1:D" & r).RemoveDuplicates Columns:=1, Header:=xlYes
    ReDim arrEval(Range("A2").End(xlDown).Row)
    r = 2
    Do Until Cells(r, 1).Value = ""
        arrEval(r - 1) = Cells(r, 1).Value
        r = r + 1
    Loop
    
    'Build arrScores from each sheet
    For sh = 2 To Sheets.Count
        With Sheets(sh)
            r = 2
            Do Until .Cells(r, 1).Value = ""
                For ev = 1 To UBound(arrEval())
                    If arrEval(ev) = .Cells(r, 1).Value Then
                        x = ev
                    End If
                Next ev
                arrScores(x, 1) = arrScores(x, 1) + .Cells(r, 2).Value
                arrScores(x, 2) = arrScores(x, 2) + .Cells(r, 3).Value
                arrScores(x, 3) = arrScores(x, 3) + .Cells(r, 4).Value
                r = r + 1
            Loop
        End With
    Next sh
    
    'insert array values into Summary sheet
    Sheets("Summary").Select
    For r = 1 To UBound(arrEval)
        Cells(r + 1, 2).Value = arrScores(r, 1)
        Cells(r + 1, 3).Value = arrScores(r, 2)
        Cells(r + 1, 4).Value = arrScores(r, 3)
    Next r
    
    'Sort summary sheet by Evaluator name and reformat columns and data
    ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add Key:=Range("A2:A" & r) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Summary").Sort
        .SetRange Range("A1:D" & r)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Columns("A:D").AutoFit
    Range("B2", Cells.SpecialCells(xlLastCell)).NumberFormat = "0.00"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Open in new window


An example workbook is attached.  No Summary sheet is shown; run the macro to see it created.

Regards,
-Glenn
EE-Example-summary.xlsm
0
 
LVL 27

Accepted Solution

by:
Glenn Ray earned 500 total points
ID: 40382484
Escanaba,

Did you have any other questions or issues?  I believe my solution (40360710) meets your needs.  If you agree can you please click the "Accept this solution" link above that post and properly close this question?

If not, please let me know and I'll be glad to help.

Regards,
-Glenn
0
 
LVL 1

Author Comment

by:Escanaba
ID: 40415888
Glenn my apologies - I've been away from work due to a passing in the family and been playing catch up for the past week.  Thank you for your assistance.
0
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 40416008
Sorry about your loss.
-Glenn
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

679 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