Average if on dynamic Range

[rex759]

Hello,
I have a worksheet that I want to add an average row after each category. I can get the added row but how do write a formula to select the changing ranges for each category?

The example shows the original data and what is should look like after the macro runs.

Excel Workbook
	A	B
1	Category	Price
2	Electric	123
3	Electric	145
4	Electric	62
5	Electric	39
6	Landscape	47
7	Landscape	921
8	Plumb	823
9	Plumb	333
10	Plumb	90
Sheet1

Excel 2010

Excel Workbook
	A	B
1	Category	Price
2	Electric	123
3	Electric	145
4	Electric	62
5	Electric	39
6	Average	92.25
7	Landscape	47
8	Landscape	921
9	Average	484.00
10	Plumb	823
11	Plumb	333
12	Plumb	90
13	Average	415.33
Sheet1

Excel 2010

Cell Formulas
Range	Formula
B6	=SUBTOTAL(1,B2:B5)
B9	=SUBTOTAL(1,B7:B8)
B13	=SUBTOTAL(1,B10:B12)

Here is a snippet of the code:

Sub test()
lasta = Worksheets("Sheet2").Range("A65536").End(xlUp).Row
Set WorkRng = Range("a2:a" & lasta)

Application.ScreenUpdating = False

For i = WorkRng.Rows.Count To 2 Step -1
    If WorkRng.Cells(i, 1).Value<> WorkRng.Cells(i - 1, 1).Value Then
        WorkRng.Cells(i, 1).EntireRow.Insert
        'add total line header
        WorkRng.Cells(i, 1) = "Average " & WorkRng.Cells(i, 1).Offset(-1, 0)
       'add averages
         WorkRng.Cells(i, 1).Offset(0, 1) = "average formula"
    End If
Next

End Sub

Any help is appreciated.

 

[Fluff]

How about

Sub rex759()
    Dim UsdRws As Long, i As Long
    Dim Rng As Range
    
Application.ScreenUpdating = False
    With Sheets("Sheet2")
        UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
        With .Range("A" & UsdRws)
            .Offset(1).Value = "Average " & .Value
        End With
        For i = UsdRws To 3 Step -1
            If .Cells(i, 1).Value <> .Cells(i - 1, 1).Value Then
                .Cells(i, 1).EntireRow.Insert
                .Cells(i, 1) = "Average " & .Cells(i, 1).Offset(-1, 0)
            End If
        Next i
        For Each Rng In .Range("B:B").SpecialCells(xlConstants).Areas
            Rng.Offset(Rng.Count)(1).Formula = "=subtotal(1," & Rng.Address & ")"
        Next Rng
    End With
End Sub

 

[rex759]

ahh, didn't think to do it separately or come up with any of that. It works perfectly. Thank you

 

[Fluff]

Glad to help & thanks for the feedback

 

[rex759]

Question: the spreadsheet has more columns that I want to add the sub total line. I know I can copy the code below and change the Range from B:B, to C:C and D:D, etc.

For Each Rng In .Range("B:B").SpecialCells(xlConstants).Areas
            Rng.Offset(Rng.Count)(1).Formula = "=subtotal(1," & Rng.Address & ")"
        Next Rng

Is there a better way to accomplish this?

 

[Fluff]

How about

        For Each Rng In .Range("B:B").SpecialCells(xlConstants).Areas
            With Rng.Offset(Rng.Count)(1)
                .Formula = "=subtotal(1," & Rng.Address & ")"
                .Offset(, 1).Formula = "=subtotal(1," & Rng.Offset(, 1).Address & ")"
                .Offset(, 2).Formula = "=subtotal(1," & Rng.Offset(, 2).Address & ")"
            End With
        Next Rng

 

[rex759]

Perfect! Thanks again

 

[Fluff]

My pleasure