Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Excel 2007 Macro To Aggregate Multiple Worksheet Totals

Posted on 2014-10-03
9
286 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
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
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 demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

860 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