Solved

Excel 2007 Macro To Aggregate Multiple Worksheet Totals

Posted on 2014-10-03
9
294 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
[X]
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
  • 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
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 
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

[Live Webinar] The Cloud Skills Gap

As Cloud technologies come of age, business leaders grapple with the impact it has on their team's skills and the gap associated with the use of a cloud platform.

Join experts from 451 Research and Concerto Cloud Services on July 27th where we will examine fact and fiction.

Question has a verified solution.

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

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

626 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