No genius here, but happy to share this with you:
Sub subtotaltest()
'place a subtotal in column(V) wherever column(U) has a blank cell
Dim lRow As Long
Dim cell As Range
Dim RowCount As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

lRow = Range("A65536").End(xlUp).Row + 1
RowCount = 0
For Each cell In Range("A2:A" & lRow)
If IsEmpty(cell) Then
cell.Offset(0, 1).FormulaR1C1 = "=SUM(R[" & -RowCount & "]C[-1]:R[-1]C[-1])"
RowCount = 0
Else
RowCount = RowCount + 1
End If
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Regards,
Ryan---

--
RyGuy


"Rick Rothstein (MVP - VB)" wrote:

I'll say it again Rick - YOU'RE A GENIUS!!!!

Then I'm afraid your standards for determining such a status are set way too
low.<g

Thank you - it does exactly what I required

Great! I'm glad my code has worked out for you.

Rick



"Rick Rothstein (MVP - VB)" wrote:

You should really stick with the original thread rather than start new
ones
for the same basic question. Here is the solution I posted back in the
original thread; the code below is meant to replace the subroutine I gave
you earlier... it will insert the double blank rows and then put the
appropriate SUM formulas in Columns D thru H (I used formulas so you
could
manually edit your data in case you find an error). Here is what I posted
earlier...

Does this subroutine do what you want?

Sub InsertTwoRows()
Dim X As Long
Dim Z As Long
Dim LastRow As Long
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = LastRow To 1 Step -1
If X = LastRow Or (Len(.Cells(X, "B").Value) 0 And _
Len(.Cells(X + 1, "B").Value) 0 And _
.Cells(X, "B").Value < .Cells(X + 1, "B").Value) Then
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
.Cells(X + 1, "C").Value = "Totals: "
.Cells(X + 1, "C").HorizontalAlignment = xlRight
End If
Next
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For X = 1 To LastRow
If .Cells(X, "C").Value = "Totals: " Then
For Z = 4 To 8
Cells(X, Z).Formula = "=SUM(" & Chr$(Z + 64) & _
Cells(X, "C").End(xlUp).Row & ":" & _
Chr$(Z + 64) & (X - 1) & ")"
Next
End If
Next
End With
End Sub


Rick


"Rayashe" wrote in message
...
Following on to this (I probably should have added it in on the first
query):
In the one blank row that has now been created after each client, I
need
to
put a total in columns D, E, F, G & H.
Again due to the differences in number of months per client it is not a
case
of just simply copying the formula.

"Rick Rothstein (MVP - VB)" wrote:

A subroutine like this should work (just change the worksheet
reference
from
Sheet1 to your actual worksheet name)...

Sub InsertTwoRows()
Dim X As Long
Dim LastRow As Long
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = LastRow - 1 To 1 Step -1
If Len(.Cells(X, "B").Value) 0 And _
Len(.Cells(X + 1, "B").Value) 0 And _
.Cells(X, "B").Value < .Cells(X + 1, "B").Value Then
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
End If
Next
End With
End Sub


Rick


"Rayashe" wrote in message
...
I have all my clients sorted in a sheet with column A containing
month
1,
2,
3, 4, up to 12 - then column B has the client code, column C client
Surname
and Name.

I need to insert 2 rows after each client and need a code to be able
to
do
this as there are over 500 clients.

I have filtered to show unique on column B, and to do a simple
keystroke
is
DOWN, DOWN, DOWN, INSERT ROW, INSERT ROW.

The problem is that some clients started and ended at various times
during
the year, so not all have the same number of entries.