Code to create summary worksheet

heyrobbie

New Member
Joined
Mar 3, 2016
Messages
2
I am just starting VBA, and I know I have a lot of reading to do, but I need to get something working for work asap.
I have a workbook with ~100 sheets and I would like to create a summary sheet with one row for each sheet, and in each row, 12 cells for the averages of 12 ranges that sheet. For example, the sheet "Spain" has B100:B110 for January data, C100:C110 for February data, D100:D110 for March, etc. On the summary sheet, I would like one row to be Spain then the January average, February average, etc. Here is my first sorry attempt: (I know there are more efficient ways to go, but as I kept getting errors I tried to get around things by brute force)
Code:
Sub average() Dim sh As Worksheet, N As Long
    Dim i As Long, M As Long
    Dim janavg As Long
    Dim febavg As Long
    Dim maravg As Long
    Dim apravg As Long
    Dim mayavg As Long
    Dim junavg As Long
    Dim julavg As Long
    Dim augavg As Long
    Dim sepavg As Long
    Dim octavg As Long
    Dim novavg As Long
    Dim decavg As Long
    




    
    N = Sheets.Count - 1
    M = 2
    For i = 1 To N
    
        Worksheets(i).Activate
        janavg = Application.WorksheetFunction.average(Range("B109:B118"))
        febavg = Application.WorksheetFunction.average(Range("c109:c118"))
        maravg = Application.WorksheetFunction.average(Range("d109:d118"))
        apravg = Application.WorksheetFunction.average(Range("e109:e118"))
        mayavg = Application.WorksheetFunction.average(Range("f109:f118"))
        junavg = Application.WorksheetFunction.average(Range("g109:g118"))
        julavg = Application.WorksheetFunction.average(Range("h109:h118"))
        augavg = Application.WorksheetFunction.average(Range("i109:i118"))
        sepavg = Application.WorksheetFunction.average(Range("j109:j118"))
        octavg = Application.WorksheetFunction.average(Range("k109:k118"))
        novavg = Application.WorksheetFunction.average(Range("l109:l118"))
        decavg = Application.WorksheetFunction.average(Range("m109:m118"))
        Sheets("Summary").Range("B" & M).PasteSpecial (janavg)
        Sheets("Summary").Range("C" & M).PasteSpecial (febavg)
        Sheets("Summary").Range("D" & M).PasteSpecial (maravg)
        Sheets("Summary").Range("E" & M).PasteSpecial (apravg)
        Sheets("Summary").Range("F" & M).PasteSpecial (mayavg)
        Sheets("Summary").Range("G" & M).PasteSpecial (junavg)
        Sheets("Summary").Range("H" & M).PasteSpecial (julavg)
        Sheets("Summary").Range("I" & M).PasteSpecial (augavg)
        Sheets("Summary").Range("J" & M).PasteSpecial (sepavg)
        Sheets("Summary").Range("K" & M).PasteSpecial (octavg)
        Sheets("Summary").Range("L" & M).PasteSpecial (novavg)
        Sheets("Summary").Range("M" & M).PasteSpecial (decavg)
        
        M = M + 1
        
    Next i


End Sub
This is not doing anything at all. Thanks in advance for any help.
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Welcome to the board. Try:
Code:
Sub average_v1()


    Dim ws      As Worksheet
    Dim wsSum   As Worksheet
    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
        
    Set wsSum = Worksheets("Summary")
    ReDim arr(1 To Worksheets.Count, 1 To 13)
        
    For x = 1 To Worksheets.Count
        Set ws = Worksheets(x)
        With ws
            If .Name <> wsSum.Name Then
                arr(x, 1) = .Name
                For y = 2 To UBound(arr, 2)
                    arr(x, y) = Application.average(.Cells(109, y).Resize(10))
                Next y
            End If
        End With
        Set ws = Nothing
    Next x
    
    With wsSum.Cells(2, 1).Resize(UBound(arr, 1), UBound(arr, 2))
        .Value = arr
        .EntireColumn.AutoFit
    End With
    
    wsSum.Select
    
    Set wsSum = Nothing
    Erase arr
    
End Sub
 
Last edited:
Upvote 0
Welcome to the board. Try:
Code:
Sub average_v1()
End Sub

Thank you! I get how the nested loops populate a 2D array, and then you print the array on the summary sheet at the end. Not sure wht the Ubound, resize, and autofit are doing, but I'll hopefully understand soon.
 
Upvote 0
You're welcome.

Ubound returns the maximum size of the array's specified dimension. This is to make the "area" of the worksheet to write the array results to, the same size as the array.

Resize, "resizes" the cell, i.e. if you have cell(1,1).Resize(2,2) it's like saying Range("A1") resized to Range("A1:B4")

Autofit is making the column width .. autofit the size of the maximum length of value in the cell in that column - like when you double-click a column to adjust it's width.
 
Upvote 0

Forum statistics

Threads
1,217,757
Messages
6,138,429
Members
450,137
Latest member
HANHAN

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top