PDA

View Full Version : [SOLVED] Need help to calculate average of those cells between two blank cells



survivor
01-10-2014, 11:20 AM
Hello guys,
I'm pretty new in this!! any help or guidance is more than welcome.

I have a long list of products. Of each product I can have more than one row or at least one. What I need is to insert a new row after each group of the same product and calculate the average of cases below the last row of each group. the chart will be like this:

ID Description Cases
3010 banana 10
3010 banana 5
3010 banana 16
3011 orange 7
3012 potatoes 19
3012 potatoes 12

I already have an small macro that will insert the new row, but I am lost with the average because i need to define the range and where to place the average. Below is the code I already have:

Sub insertrow()
Dim i As Integer
For i = 2 To Cells(1, 1).End(xlDown).Row 'itereate thru all rows
If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then 'compare the cells in col 1 with previous row
Rows(i).EntireRow.Insert 'insert a row if the values don't match
i = i + 1 'since we inserted a row we have to make i bigger to go down
End If
Next i
End Sub

Please, I will appreciate any help.

Thanks

vert
01-10-2014, 11:53 AM
hi survivor,

There is probably a cleaner way to do it but this is what I have used.


Sub test()

With ActiveWorkbook.Worksheets(1)

Row = 2
FirstRow = 2
Do Until .Range("A" & Row).Text = ""
If .Range("A" & Row).Text = .Range("A" & Row + 1).Text Then
Row = Row + 1
Else
.Range("A" & Row + 1).EntireRow.Insert
.Range("C" & Row + 1).Formula = "=average(C" & FirstRow & ":C" & Row & ")"
FirstRow = Row + 2
Row = FirstRow
End If
Loop

End With

End Sub

Bob Phillips
01-10-2014, 12:10 PM
Another way


Sub insertrow()
Dim formulaRow As Long
Dim lastrow As Long
Dim i As Long

lastrow = Cells(1, 1).End(xlDown).Row
formulaRow = lastrow + 1
For i = lastrow To 2 Step -1

If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then

Rows(i + 1).Insert
Cells(i + 1, "C").Formula = "=AVERAGEIF(B1:B" & lastrow & ",B" & i & ",C1:C" & lastrow & ")"
End If
Next i
End Sub

survivor
01-10-2014, 01:23 PM
Hi thanks a lot for your quick reply.
it is awesome.

survivor
01-10-2014, 01:25 PM
Hi XLD,

Great, I tried this way and works too. I'm very happy thanks VBA Express!! I'm learning.