Collecting Average from multiple sheets in Vba

Question

I need to calculate the average of a certain range ("C2:C11") from several worksheets into a new worksheet. The function should still work if a new sheet is added and data is entered into the specified range.

So far I have this

....

Sheets.Add

Dim myavg As Collection
Set myavg = New Collection

For Each wsheet In Worksheets
   myavg.Add wsheet.Range("B2:B11")
Next    
For i = 1 To myavg.Count
   avg1 = Application.WorksheetFunction.Average(Range("B2:B11"))
Next

curColumn = 5
curRow = 4

For i = 1 To myavg.Count
   ActiveSheet.Cells(curRow, curColumn).Value = avg1
   curRow = curRow + 1
Next

...

It returns one number into the desired range of the new sheet and its not accurate

Please help me understand what I am doing wrong. Thank you in advance.

There is a lot of overkill in this code. You absolutely do not need to use a Collection to achieve this. Just use a for each on the Worksheets, calculate the average and output it in the proper cell all at once instead of using 3 (!!) for loops. — ApplePie
As for the accuracy problem, what is the data type of avg1 ? — ApplePie

chris neilsen chris neilsen · Accepted Answer · 2012-10-21T23:27:33

Putting aside whether or not a Collection is a good idea for this task, lets examine your code:

General
You may have already done this, but it warrents repeating
Use Option Explicit and decalre all your variables

Your Code

Sheets.Add

This adds a new Worksheet to the active Workbook, and puts it before the currently active sheet, then activates the new sheet.
Problems: You are relying on the default behaviour to get a new Worksheet, you can't be sure where the new sheet is located, and you have no reference to it.
Suggestions:
Get a reference to a workbook object and use that throughout your code

Dim wb As Workbook
Set wb = ActiveWorkbook

Control what, where and how you add to the workbook

Dim wsSummary as Worksheet
Set wsSummary = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
wsSummary.Name = "Summary"

Your Code

For Each wsheet In Worksheets
    myavg.Add wsheet.Range("B2:B11")
Next

This creates a Collection of Range's, from every Worksheet in the book, including the one we just created. I'm guessing you don't want to include that one. For ease of maintenance you should create a variable to hold the range and use that throughout the code. Lets apply the above

Dim wsheet as WorkSheet
Dim RangeAddress As String
RangeAddress = "B2:B11"
For Each wsheet In wb.Worksheets
    If wsheet.name <> wsSummary.Name Then
        myavg.Add wsheet.Range(RangeAddress)
    End If
Next

Your Code

For i = 1 To myavg.Count
    avg1 = Application.WorksheetFunction.Average(Range("B2:B11"))
Next

Problems: You are iterating over the Collection but not referencing it in the loop. Each time through you calculate avg1 and then overwrite it on the next loop.
Each time through the loop you calculate the average of a range on the Active Sheet (which will be the blank new sheet just added)
Suggestions:
Jumping ahead, it looks like you want to list the averages on the new sheet, one per sheet on successive rows. So lets store the averages in an array to be put on the summary sheet later. Note that if any of the Range's are empty, Average will cause an error.

Dim avg() as Variant
Redim avg(1 to myavg.Count, 1 To 1)
For i = 1 To myavg.Count
    avg(i, 1) = Application.WorksheetFunction.Average(myavg(i))
Next

Your Code

curColumn = 5
curRow = 4

For i = 1 To myavg.Count
    ActiveSheet.Cells(curRow, curColumn).Value = avg1
    curRow = curRow + 1
Next

Problems:
This code simply puts the last calculated value of avg1 onto successive rows

Putting the result onto the new sheet: having collected the averages into an array, lets put that onto the sheet

Dim curColumn as Long, curRow As Long
curColumn = 5
curRow = 4

wsSummary.Cells(curRow, curColumn).Resize(UBound(avg, 1), 1) = avg

Whats not delt with so far is Error Handling. There are many ways code can go wrong, so it's wise to include Error Handling in your code. Eg what if there was already a sheet named "Summary"? What if Average returns an error?

Turning to whether this is a good method, it should be clear that having created an array to hold the results, that array could be populated in the pass through the workbook.

Something like this

Sub Demo()
    Dim wb As Workbook
    Set wb = ActiveWorkbook

    Dim RangeAddress As String
    RangeAddress = "B2:B11"

    Dim wsSummary As Worksheet

    Dim avg() As Variant
    ReDim avg(1 To wb.Worksheets.Count, 1 To 1)
    For i = 1 To UBound(avg, 1)
        With wb.Worksheets(i).Range(RangeAddress)
            If WorksheetFunction.Count(.Value) > 0 Then
                avg(i, 1) = WorksheetFunction.Average(.Value)
            Else
                avg(i, 1) = "No Values On Sheet"
            End If
        End With
    Next

    Dim curColumn As Long, curRow As Long
    curColumn = 5
    curRow = 4

    On Error Resume Next
    Set wsSummary = wb.Worksheets("Summary")
    If Err.Number <> 0 Then
        ' Summary sheet does not exist, create it
        Err.Clear
        On Error GoTo 0
        Set wsSummary = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
        wsSummary.Name = "Summary"
    Else
        On Error GoTo 0
        ' Summary sheet already exists
        ' what do you wnat to do?
    End If

    wsSummary.Cells(curRow, curColumn).Resize(UBound(avg, 1), 1) = avg

End Sub

This code may still have problems, depending on your exact requirements (eg if "Summary" sheets already exists, this will process it in the average loop)

Collecting Average from multiple sheets in Vba

1 Answers