This is a bit tricky to program, because inserting a row immediately above the row with Average will not adjust the AVERAGE formula automatically. Rather than trying to modify the formula in the macro, I chose to insert a row one row up; because that row is within the range of the AVERAGE formula, Excel updates the formula correctly.

And you have to watch out for FindNext returning to the top. So I added a check for that.

Here are two slightly different versions that do the same; you can use either of them.

Code: Select all

```
Sub InsertAboveAverage()
Dim lngVal As String
Dim cel As Range
Dim r As Long
' Find "Average"
Set cel = Cells.Find(What:="Average", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cel Is Nothing Then
Do
' Store current row
r = cel.Row
' Get the number at the end
lngVal = Right(Range("A" & (r - 1)).Value, 2)
' Insert a row one up
cel.Offset(-1, 0).EntireRow.Insert
' Fill the cells in column A.
Range("A" & (r - 1)).Value = "CW_2011_" & lngVal
Range("A" & r).Value = "CW_2011_" & (lngVal + 1)
' Fill the cells in columns B and C upwards
Range("B" & (r - 1) & ":C" & r).FillUp
' Find next "Average"
Set cel = Cells.FindNext(After:=cel.Offset(1, 0))
' Stop when we loop back to the top
Loop Until cel.Row < r
End If
End Sub
Sub InsertAboveAverage2()
Dim cel As Range
Dim r As Long
' Find "Average"
Set cel = Cells.Find(What:="Average", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cel Is Nothing Then
Do
' Store current row
r = cel.Row
' Insert a row one up
cel.Offset(-1, 0).EntireRow.Insert
' Fill the cells in column A downwards
Range("A" & (r - 2)).AutoFill Destination:=Range("A" & (r - 2) & ":A" & r)
' Fill the cells in columns B and C upwards
Range("B" & (r - 1) & ":C" & r).FillUp
' Find next "Average"
Set cel = Cells.FindNext(After:=cel.Offset(1, 0))
' Stop when we loop back to the top
Loop Until cel.Row < r
End If
End Sub
```