Insert Sum in blank Row

[Rayashe]

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.

 

[Bernie Deitrick]

Try this macro. Select all the cells with values, and then run the correct version...


Sub PutInSums()
Dim myA As Range
For Each myA In Selection.SpecialCells(xlCellTypeConstants, 23).Areas
'Comment out the above line and uncomment the next line if
'you have formulas instead of constants
'For Each myA In Selection.SpecialCells(xlCellTypeFormulas, 23).Areas
myA.Cells(myA.Rows.Count + 1, 1).Resize(1, myA.Columns.Count).Formula = _
"=SUM(" & myA.Columns(1).Address(False, False) & ")"
Next myA
End Sub


HTH,
Bernie
MS Excel MVP

 

[Rick Rothstein \(MVP - VB\)]

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]

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

Thank you - it does exactly what I required

 

[Rick Rothstein \(MVP - VB\)]

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

Thank you - it does exactly what I required

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

Rick

 

[ryguy7272]

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---