Solved

Excel 2007 Macro To Aggregate Multiple Worksheet Totals

Posted on 2014-10-03
9
278 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 25

Expert Comment

by:ProfessorJimJam
Comment Utility
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
Comment Utility
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 25

Expert Comment

by:ProfessorJimJam
Comment Utility
is your other sheets are always 6 columns? i mean from A to F?
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
Comment Utility
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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 1

Author Comment

by:Escanaba
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Sorry about your loss.
-Glenn
0

Featured Post

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

Join & Write a Comment

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
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.

743 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

14 Experts available now in Live!

Get 1:1 Help Now