Re: Inserting blank rows plus using Sum
- From: Sheeloo <to_sAAheeloo@xxxxxxxxxxxxxxxxx just remove all As...>
- Date: Wed, 8 Apr 2009 11:38:01 -0700
Try this...
It will inserst a SUM formula
Sub insert_sum_values()
Dim sum_of_range, tmp
For i = 2 To 8
If i = 2 Or i = 6 Or i = 7 Or i = 8 Then
'column numbers where sums required
Cells(3, i).Select
'first cell at top of range to be summed
Do
Range(ActiveCell, ActiveCell.End(xlDown)).Select
tmp = ActiveCell.Value
If tmp <> "" Then
sum_of_range = "=SUM(" & Selection.Address & ")"
ActiveCell.End(xlDown).Offset(1, 0).Value = sum_of_range
ActiveCell.End(xlDown).Offset(2, 0).Select
Else
sum_of_range = ""
End If
Loop Until sum_of_range = ""
End If
Next i
End Sub
-------------------------------------
Pl. click ''''Yes'''' if this was helpful...
"Bill95051" wrote:
.
"AltaEgo" wrote:
It may be possible to do this more efficiently but the sub below will insert
totals per your example.
Call the Sub after you insert your two blank rows.
I did not develop a routine to check that there are two blank rows between
sections so be careful to call it once only. Calling it twice or more does
modify existing data but could cause confusion.
Modified substantially from code located at
http://www.mrexcel.com/archive/VBA/4272.html
Thanks. I took your macro and tweaked some more. Here is what came out.
I changed the variable i to row and the Sub-sub's variable to col (they
conflicted with each other and also made it more readable). Passed the row
info to the Sub-sub. Had to change ActiveCell to ...End(xlup) instead of
down and trimmed out a few extra lines. Still have a problem with accurate
Summing from group to group. Somehow the Sum function still gets the wrong
column size. The original macro would do the first change in symbol, but
then ran to the bottom and Summed the whole remaining column.
Sub SumAndSeparate()
StartRow = 3 'Change the 2 to the row actual data start
DataColumn = 1 'Change the 1 to the column where your data is
row = StartRow + 1
While Cells(row, DataColumn) <> ""
If Cells(row, DataColumn) <> Cells(row - 1, DataColumn) Then
Cells(row, DataColumn).EntireRow.Insert
Cells(row, DataColumn).EntireRow.Insert
SumValues (row)
row = row + 2
End If
row = row + 1
Wend
End Sub
Sub SumValues(row)
Dim sum_of_range, tmp
For col = 2 To 8
If col = 2 Or col = 6 Or col = 7 Or col = 8 Then
'column numbers where sums required
Cells(row, col).Select
'first cell at top of range to be summed
tmp = ActiveCell.Value
If ActiveCell.Value() = None Then
Range(ActiveCell.Offset(-2), ActiveCell.End(xlUp)).Select
' Range(ActiveCell, ActiveCell.End(xlUp)).Select
sum_of_range = Application.WorksheetFunction.Sum(Selection)
ActiveCell.Offset(2, 0).Value = sum_of_range
Else
sum_of_range = ""
End If
End If
' Range(ActiveCell.Offset(1)).Select
Next col
Cells(row + 2, col - 7).Select
End Sub
Thanks for the idea
Bill
- References:
- Inserting blank rows plus using Sum
- From: Bill95051
- Re: Inserting blank rows plus using Sum
- From: AltaEgo
- Re: Inserting blank rows plus using Sum
- From: Bill95051
- Inserting blank rows plus using Sum
- Prev by Date: work out commission after percentage and other costs deducted
- Next by Date: RE: work out commission after percentage and other costs deducted
- Previous by thread: Re: Inserting blank rows plus using Sum
- Next by thread: How do I retrive data
- Index(es):
Relevant Pages
|