Insert a text in Column A and calculate the average from column B

[Sverre]

I have a sheet of 20000 rows or more. I have a grouped the sheet with one
blank line. In this blank line I want to insert a text in Column A like this;
content in the cell above+data. In addition I want to put in a formula
calculating the average for the group above from column B to column U.
CAn anyone help me with a VBA to do this. May be I have to put in two blank
lines ?

A B C
May
May
May
Maydata Average Average
June
June
June
Jundata

 

[Jacob Skaria]

Assuming that your data will not have any blank lines inbeween, the below
macro will insert a blank row between each group, insert a text in ColA with
<RangeString> & "Data" and then will insert the Average formula from ColB to
Col U. Please try and feedback

Sub InsertAverages()

Dim lngRow As Long
Dim lngCol As Long
Dim lngStartRow As Long
Dim strCurData As String

lngRow = 1
lngStartRow = lngRow
strCurData = Range("A" & lngRow)

Do While Range("A" & lngRow) <> ""
If strCurData <> Range("A" & lngRow) Then
Rows(lngRow).Insert
Range("A" & lngRow) = strCurData & " Data"
'Insert Averages from ColB to U
For lngCol = 2 To 21
Cells(lngRow, lngCol).FormulaR1C1 = "=Average(R" & lngStartRow & "C:R" &
lngRow - 1 & "C)"
Next
lngRow = lngRow + 1
lngStartRow = lngRow
strCurData = Range("A" & lngRow)
End If

lngRow = lngRow + 1
Loop

'Handle Last Range
Range("A" & lngRow) = strCurData & " Data"
For lngCol = 2 To 21
Cells(lngRow, lngCol).FormulaR1C1 = "=Average(R" & lngStartRow & "C:R" &
lngRow - 1 & "C)"
Next

End Sub


If this post helps click Yes

 

[Nigel]

Will insert formula into empty row - based on empty column A.

Sub SetAverage()
Dim lfR As Long, llR As Long
Dim lcR As Long

On Error GoTo errHandler
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With ActiveSheet
lfR = 1
For lcR = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row + 1
If Len(Trim(.Cells(lcR, 1))) = 0 Then
.Cells(lcR, 1) = .Cells(lcR - 1, 1) & "- Averages"
.Cells(lcR, 2).Formula = "=AVERAGE(B" & lfR & ":B" & lcR - 1 & ")"
.Cells(lcR, 2).Copy Destination:=.Range(.Cells(lcR, 3), .Cells(lcR,
21))
lfR = lcR + 1
End If
Next
End With

errHandler:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

 

[Sverre]

Thanks Jacob. I got a massage Compile error in theese statements:
Cells(lngRow, lngCol).FormulaR1C1 = "=Average(R" & lngStartRow & "C:R" &
lngRow -1 & "C)"
Is the statement to long ? I traied to put a _ afrer & but it do not help.


Jacob Skaria skrev:

 

[Jacob Skaria]

Please try this

Sub InsertAverages()

Dim lngRow As Long
Dim lngCol As Long
Dim lngStartRow As Long
Dim strCurData As String

lngRow = 1
lngStartRow = lngRow
strCurData = Range("A" & lngRow)

Do While Range("A" & lngRow) <> ""
If strCurData <> Range("A" & lngRow) Then
Rows(lngRow).Insert
Range("A" & lngRow) = strCurData & " Data"
'Insert Averages from ColB to U
For lngCol = 2 To 21
Cells(lngRow, lngCol).FormulaR1C1 = _
"=Average(R" & lngStartRow & "C:R" & lngRow - 1 & "C)"
Next
lngRow = lngRow + 1
lngStartRow = lngRow
strCurData = Range("A" & lngRow)
End If

lngRow = lngRow + 1
Loop

'Handle Last Range
Range("A" & lngRow) = strCurData & " Data"
For lngCol = 2 To 21
Cells(lngRow, lngCol).FormulaR1C1 = _
"=Average(R" & lngStartRow & "C:R" & lngRow - 1 & "C)"
Next

End Sub

 

[Sverre]

Thank you very very much, it works perfectly. Its a good and happy day to day.
Sverre

Jacob Skaria skrev:

 

[Sverre]

Thank you Nigel.
Thank you. This works too. Its a useful program. wich I have stored in my
collection.

Nigel skrev:

 

[Sverre]

At a closer look, it works only for the first blank line, not at the 2. and
3. and so on.

Sverre skrev: