Inserting Row and Sum Columns VBA

TheWildAfrican

Board Regular
Joined
Apr 23, 2013
Messages
70
Dear All:

I'm trying to write a VBA code that would "Insert Rows" to separate cells with different names and "Sum" the contents of the "Separated" cells.

The file crashes each time I tried to run it.

Please the codes below. I hope you could point out what I've been doing wrong.

Thank you for your anticipated help.

Sub Sum_And_InsertRows()

Dim sum_start As Integer
Dim cnt_add_rows As Integer
Dim i As Integer
Dim fac_name As String

'initialize variable
sum_start = 0
cnt_add_rows = 0

Range("E3").Select

i = 0

While Not (IsEmpty(ActiveCell.Offset(i, 0).Value))
fac_name = ActiveCell.Offset(i, 0).Value
sum_start = i

While (ActiveCell.Offset(i, 0).Value = fac_name)

'Separating Deal names and inserting rows
If (ActiveCell.Offset(i - 1, -2).Value <> ActiveCell.Offset(i, -2).Value) Then
ActiveCell.Offset(i + cnt_add_rows, 0).EntireRow.Insert
End If

i = i + 1

Wend

ActiveCell.Offset(i - 1, 7).Value = Application.WorksheetFunction.Sum(Range(ActiveCell.Offset(sum_start, 7), ActiveCell.Offset(i - 1, 7)))

i = i + 1

Wend

End Sub
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,026
From what I see you are selecting E3, if you are inserting rows, you are basically pushing the range down, and the loop will never end.

You need to start at the bottom and work your way up.
I thing you want to loop through column E but see if column C values change?
If not, you should be able to adjust the code to your needs.
VBA Code:
Sub InsertRows()
    Dim sh As Worksheet
    Dim x As Long

    Set sh = ActiveSheet
    With sh
        For x = .Cells(.Rows.Count, "E").End(xlUp).Row To 4 Step -1
            If .Cells(x, "C").Value <> .Cells(x - 1, "C").Value Then
                .Cells(x, "E").EntireRow.Insert
            End If
        Next
    End With
End Sub
 

TheWildAfrican

Board Regular
Joined
Apr 23, 2013
Messages
70
Hi Davesexcel,

Many thank you for your response.

I'll try your method and let you know if it works.

I appreciate your help.

PEACE!!

TWA
 

TheWildAfrican

Board Regular
Joined
Apr 23, 2013
Messages
70
Hi Davesexcel,

Thanks again for providing a better method to insert rows.

The method works great; however, I could not sum the separated rows using the method.

Would you know the best way to "Sum" the separated rows?

Thanks for your help.

Concrete Respect!!

TWA
 

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,026

ADVERTISEMENT

Try this

VBA Code:
Sub GetSubs()
    
    Dim RNG As Range, c As Range
    Dim x, y
    Set RNG = Range("G4:G" & Cells(Rows.Count, "G").End(xlUp).Row + 1)
    For Each c In RNG.Cells
        x = 4
        If c = "" Then
            x = y + 2
            y = c.Offset(-1).Row
            c = Application.WorksheetFunction.Sum(Range(Cells(y, "G"), Cells(x, "G")))
            
        End If
        
    Next c
    
End Sub
 

TheWildAfrican

Board Regular
Joined
Apr 23, 2013
Messages
70
Hi Davesexcel,

Thanks for your help, Dave.

I'll try this and let you know if it works.

Maximum Respect!!

TWA
 

TheWildAfrican

Board Regular
Joined
Apr 23, 2013
Messages
70

ADVERTISEMENT

Hi Davesexcel,

Thank you for all your help and efforts. I've tried using different scenarios with your code, unfortunately I couldn't get it to work.

I truly appreciate your effort, boss.

PEACE!!

TWA
 

TheWildAfrican

Board Regular
Joined
Apr 23, 2013
Messages
70
Hi Dave,

Thanks for your response. Most importantly, thanks for all your help.

The inserting rows code works fine. However, I could not get the sum code to work.

I can provide the columns I need to sum are columns L, M, and N.

Please let me know if you need a additional details.

Best,

TWA
 

TheWildAfrican

Board Regular
Joined
Apr 23, 2013
Messages
70
Hello Davesexcel and All:

Many thanks for helping on this code.

I'm happy to let you know that I got the code working; albeit "inefficiently"...:):):)

Below is what the updated code.

Thanks to all for your help.

Sub Sum_And_InsertRows()

Dim sum_start As Integer
Dim cnt_add_rows As Integer
Dim i As Integer
Dim fac_name As String

'initialize variable
sum_start = 0
cnt_add_rows = 0

Range("C3").Select ====> I changed this active range as there are many rows contents alike on the previous one I used...

i = 0

While Not (IsEmpty(ActiveCell.Offset(i, 0).Value))
fac_name = ActiveCell.Offset(i, 0).Value
sum_start = i

While (ActiveCell.Offset(i, 0).Value = fac_name)

'Separating Deal names and inserting rows
If (ActiveCell.Offset (i , 0).Value <> ActiveCell.Offset (I-1, 0).Value) Then
ActiveCell.Offset (I, 30).value = ActiveCell.Offset (I, 9).value*1 =====> I changed this line from my previous line of "InsertRow.Entire"
End If

i = i + 1

Wend

ActiveCell.Offset (I + cnt_add_row, 0).InsertRow.Entire

i = i + 1

ActiveCell.Offset (i - 1, 9).Value = Application.WorksheetFunction.Sum(Range(ActiveCell.Offset(sum_start, 9), ActiveCell.Offset(i - 1, 9)))

ActiveCell.Offset (I, 0).InsertRow.Entire

i = i + 1

Wend

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,114,314
Messages
5,547,166
Members
410,775
Latest member
alal1030
Top