ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VBA Assistance _ Summing (https://www.excelbanter.com/excel-programming/356353-vba-assistance-_-summing.html)

tom

VBA Assistance _ Summing
 
I am currently using this code (see below) to insert rows where the #'s
change in a column "E". Runs great, however I would like to sum the rows
proceeding the inserted rows (by Column - L,M,N,and O) .
TFTH,
Tom

Sub InsertRows()

Dim StartRow As Long
Dim DataColumn As Long
Dim LastRow As Long
Dim iRow As Long

With ActiveSheet
StartRow = 6
DataColumn = 5
LastRow = .Cells(.Rows.Count, DataColumn).End(xlUp).Row

For iRow = LastRow To StartRow Step -1
If .Cells(iRow, DataColumn).Value _
= .Cells(iRow - 1, DataColumn).Value Then
'do nothing
Else
.Rows(iRow).Resize(2).Insert
End If
Next iRow
End With
End Sub


Jim Cone

VBA Assistance _ Summing
 
Tom,
'------------------
Sub InsertRowsRevised()
Dim rngCell As Excel.Range
Dim rngSum As Excel.Range
Dim rngData As Excel.Range
Dim rngRow As Excel.Range
Dim DataColumn As Long
Dim i As Long

Application.ScreenUpdating = False
DataColumn = 5
Set rngCell = Cells(6, DataColumn)
Set rngRow = Cells(Rows.Count, DataColumn).End(xlUp)
Set rngData = Range(rngCell, rngRow)

Set rngRow = rngCell

Do
If rngCell.Value < rngCell(2, 1).Value Then
rngCell(2, 1).EntireRow.Resize(2).Insert

For i = 8 To 11
Set rngSum = Range(rngRow(1, i), rngCell(1, i))
rngCell(2, i).Value = Application.Sum(rngSum)
rngCell(2, 1).Value = "Total: "
rngCell(2, 1).Font.Bold = True
Next i
Set rngCell = rngCell(4, 1)
Set rngRow = rngCell
Else
Set rngCell = rngCell(2, 1)
End If
Loop Until Application.Intersect(rngCell, rngData) Is Nothing
Application.ScreenUpdating = True
End Sub
'--------------

Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware




"Tom" wrote in message
I am currently using this code (see below) to insert rows where the #'s
change in a column "E". Runs great, however I would like to sum the rows
proceeding the inserted rows (by Column - L,M,N,and O) .
TFTH,
Tom

Sub InsertRows()

Dim StartRow As Long
Dim DataColumn As Long
Dim LastRow As Long
Dim iRow As Long

With ActiveSheet
StartRow = 6
DataColumn = 5
LastRow = .Cells(.Rows.Count, DataColumn).End(xlUp).Row

For iRow = LastRow To StartRow Step -1
If .Cells(iRow, DataColumn).Value _
= .Cells(iRow - 1, DataColumn).Value Then
'do nothing
Else
.Rows(iRow).Resize(2).Insert
End If
Next iRow
End With
End Sub



All times are GMT +1. The time now is 03:25 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com