repeat row addition with formulas

[Jrenville]

My data always looks like the below. Title changes every after 5th line
I need to add 4 rows with Min,Max,Range, and average for each new title.

Title	Y	Z	A	B	C	D	F
S01 811A	2.5	108.8	1.61	34.6	-74	34.8	811
S01 811A	5	120.6	1.68	38.9	-81.5	39	811
S01 811A	7.5	94.1	1.61	31	-63	31.1	811
S01 811A	10	100.1	1.62	33.9	-66	34.1	811
S01 811A	12.5	106.4	1.64	36.9	-69.4	37.1	811
S02 753A	2.5	104.8	1.63	32.5	-72.1	32.7	753
S02 753A	5	132.9	1.65	37	-95.7	37.2	753
S02 753A	7.5	107.8	1.64	38.3	-69.4	38.5	753
S02 753A	10	122.5	1.65	35.8	-86.5	36	753
S02 753A	12.5	107.5	1.65	36.6	-70.7	36.9	753
S03 767A	2.5	121.8	1.63	36.9	-84.7	37.1	767
S03 767A	5	103	1.63	33.5	-69.3	33.8	767
S03 767A	7.5	108	1.63	32.2	-75.7	32.3	767
S03 767A	10	99.9	1.62	31.4	-68.3	31.7	767
S03 767A	12.5	100	1.62	32.7	-67.1	32.9	767

<tbody>
</tbody>

Need to do this:

Title	Y	Z	A	B	C	D	F
S01 811A	2.5	108.8	1.61	34.6	-74	34.8	811
S01 811A	5	120.6	1.68	38.9	-81.5	39	811
S01 811A	7.5	94.1	1.61	31	-63	31.1	811
S01 811A	10	100.1	1.62	33.9	-66	34.1	811
S01 811A	12.5	106.4	1.64	36.9	-69.4	37.1	811
min			1.61	31		31.1
max			1.68	38.9		39
range			0.07	7.9		7.9
average			1.632	35.06		35.22
S02 753A	2.5	104.8	1.63	32.5	-72.1	32.7	753
S02 753A	5	132.9	1.65	37	-95.7	37.2	753
S02 753A	7.5	107.8	1.64	38.3	-69.4	38.5	753
S02 753A	10	122.5	1.65	35.8	-86.5	36	753
S02 753A	12.5	107.5	1.65	36.6	-70.7	36.9	753

<tbody>
</tbody>

I have this code that I recorded. It works when I put on the right row. I just want it to repeat after 5 lines until there are empty cells because I do not have a specific number of samples: I'm just not really sure how to get it to repeat and stop.

Sub Insert_Rows()
'
' Insert_Rows Macro
' Inserts rows, adds min,max,range,average
'


'
    Rows("7:7").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "min"
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "max"
    Range("A9").Select
    ActiveCell.FormulaR1C1 = "range"
    Range("A10").Select
    ActiveCell.FormulaR1C1 = "average"
    Range("D7").Select
    ActiveCell.FormulaR1C1 = "=MIN(R[-5]C:R[-1]C)"
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "=MAX(R[-6]C:R[-2]C)"
    Range("D9").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C-R[-2]C"
    Range("D10").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(R[-8]C:R[-4]C)"
    Range("D7:D10").Select
    Selection.Copy
    Range("E7").Select
    ActiveSheet.Paste
    Range("G7").Select
    ActiveSheet.Paste
End Sub

Thanks in advance
Jason

 

[Fluff]

Hi & welcome to the board.
How about

Sub Insert_Rows()
    
   Dim Cnt As Long
   
   For Cnt = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -5
      Rows(Cnt + 1).Resize(4).Insert
      Range("A" & Cnt + 1).Resize(4).Value = Application.Transpose(Array("Min", "Max", "Range", "Average"))
      Range("D" & Cnt + 1).Resize(, 4).FormulaR1C1 = "=MIN(R[-5]C:R[-1]C)"
      Range("D" & Cnt + 2).Resize(, 4).FormulaR1C1 = "=MAX(R[-6]C:R[-2]C)"
      Range("D" & Cnt + 3).Resize(, 4).FormulaR1C1 = "=R[-1]C-R[-2]C"
      Range("D" & Cnt + 4).Resize(, 4).FormulaR1C1 = "=AVERAGE(R[-8]C:R[-4]C)"
      Range("F" & Cnt + 1).Resize(4).ClearContents
   Next Cnt
End Sub

 

[Jrenville]

Wow thanks, works like a champ and SO much simpler that what I was trying to do. You rock!

 

[Fluff]

Glad to help & thanks for the feedback