Excel VBA - Add row & make active

Question

Good evening

Please see the attached image for an example of my data. The strings in column A are grouped together.

enter image description here

The below code is a WIP to achieve the following...

Find the last occurrence of each delivery location & add a new row after.
In the newly created row, in the columns named Header11-14, add a formula to total the values in the above rows
Do some formatting

So far it adds the new row after each delivery location but what I can't figure out is how to add the sum formula. I know how to add the string but I can't figure out how to reference the cells above...

enter image description here

The image above what i'm trying to achieve.

Sub insertRow_totals()
Dim changeRow, counter As Integer

counter = 2

While Cells(counter, 1) <> ""
    If Cells(counter, 1) <> Cells(counter - 1, 1) Then
        Rows(counter).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

        counter = counter + 2
    End If
    counter = counter + 1
Wend

Rows(2).EntireRow.Delete
End Sub

Thanks for your quick response. The data will be pulled from Access and may vary in length. The groupings will vary in size. — IainW
– IainW, Commented Jun 16, 2015 at 20:13
I agree with @vacip. Use Subtotals. Record a macro for subtotals. Simply amend the code so that works on realtime data of varying lengths. — Siddharth Rout
– Siddharth Rout, Commented Jun 16, 2015 at 20:18

h3n · Accepted Answer · 2015-06-16 21:09:11Z

1

you need to count how many rows with the same name there are (or remember the row index of the first one), then something like this should work

Sub insertRow_totals()
Dim changeRow, counter As Integer

counter = 2
FirstRow = 2

While Cells(counter, 1) <> ""
    If Cells(counter, 1) <> Cells(counter - 1, 1) Then
        Rows(counter).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For i = 11 To 14
        ActiveSheet.Cells(counter, i).Formula = "=SUM(" & Cells(FirstRow, i).Address & ":" & Cells(counter - 1, i).Address & ")"
    Next i

    counter = counter + 1
    FirstRow = counter
End If
    counter = counter + 1
Wend

Rows(2).EntireRow.Delete
End Sub

edited Jun 16, 2015 at 21:09

answered Jun 16, 2015 at 20:16

h3n

8981 gold badge11 silver badges28 bronze badges

Sign up to request clarification or add additional context in comments.

Collectives™ on Stack Overflow

Excel VBA - Add row & make active

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related