Insert a Column Sum using VBA

Question

I am exporting data to a workbook from Access. The data is grouped by a customer name. I have the following code that works perfectly to insert a row between each customer.

Sub InsertRows()

  Dim lastRow As Long

  Dim rowPtr As Long

  lastRow = Range("A" & Rows.Count).End(xlUp).Row

  For rowPtr = lastRow To 2 Step -1

    If Not IsEmpty(Range("A" & rowPtr)) Then

      If Range("A" & rowPtr) <> Range("A" & rowPtr - 1) Then

        Range("A" & rowPtr).EntireRow.Insert

      End If

    End If

  Next

End Sub

But I need to then place Totals for most of the columns in that blank Row. I need to know a) how to insert a Sum() formula that would sum only up to the next blank row and b) whether I should do it within the above loop or as a separate loop. Note that not every row will have values in every column. So I think I need to determine the first blank row in the Customer name column (which will all have data). I'm guessing I can probably create the formula once then copy it to all the columns I need to. 

One other issue here is that some customers may only have one row of data some may have many. 

So can anyone give me a hand with this?

Answer 1

Ok, dynamic offset. Scott, please check below code. Update range per your requirement. Have converted column nos to column letters & this should be valid for column limit per Excel 2007 (16384 columns).

Sub InsertRows_1()

  Dim lastRow As Long

  Dim rowPtr As Long

  Dim lStartRow As Long, lEndRow As Long

  Dim lColNo As Long, sOffset As String

  lastRow = Range("A" & Rows.count).End(xlUp).Row

  lEndRow = lastRow + 1

  For rowPtr = lastRow To 2 Step -1

    If Not IsEmpty(Range("A" & rowPtr)) Then

      If Range("A" & rowPtr) <> Range("A" & rowPtr - 1) Then

        Range("A" & rowPtr).EntireRow.Insert

        lStartRow = rowPtr + 1

        For lColNo = 1 To 7

            'this inserts sum formula in columns C, D & E

            If lColNo < 6 And lColNo > 2 Then

                sOffset = Split(Cells(1, lColNo).Address, "$")(1)

                Range("A" & lEndRow + 1).Offset(0, lColNo - 1) = "=SUM(" & sOffset & lStartRow & ":" & sOffset & lEndRow & ")"

            End If

        Next lColNo

        lEndRow = lStartRow - 1

      End If

    End If

  Next

    lStartRow = 1

    For lColNo = 1 To 7

        'this inserts sum formula in columns C, D & E

        If lColNo < 6 And lColNo > 2 Then

            sOffset = Split(Cells(1, lColNo).Address, "$")(1)

            Range("A" & lEndRow).Offset(0, lColNo - 1) = "=SUM(" & sOffset & lStartRow & ":" & sOffset & lEndRow - 1 & ")"

        End If

    Next lColNo

End Sub

Have also updated the OR to AND within the IF statement.

Regards,

Amit Tandon

Answer 2

Amit,

That is very close. I modified the first post like this:

Sub InsertRows()

  Dim lastRow As Long

  Dim rowPtr As Long

  Dim lStartRow As Long, lEndRow As Long

  Dim i As Integer

  lastRow = Range("A" & Rows.Count).End(xlUp).Row

  lEndRow = lastRow + 1

  For rowPtr = lastRow To 2 Step -1

    If Not IsEmpty(Range("A" & rowPtr)) Then

      If Range("A" & rowPtr) <> Range("A" & rowPtr - 1) Then

        Range("A" & rowPtr).EntireRow.Insert

        lStartRow = rowPtr + 1

        For i = 6 To 93

            If i < 17 Or i > 22 Then

                Range("A" & lEndRow + 1).Offset(0, i).Formula = Range("B" & lEndRow + 1) = "=SUM(B" & lStartRow & ":B" & lEndRow & ")"

            End If

        Next i

        lEndRow = lStartRow - 1

      End If

    End If

  Next

    lStartRow = 1

    Range("A" & lEndRow).Offset(0, 1) = Application.Sum(Range("A" & lStartRow & ":A" & lEndRow - 1).Offset(0, 1))

End Sub

This work to insert the sum in the columns I needed to sum. However, your second response picked up that I don't want to insert the result of the Sum but the Actual formula (i.e. =SUM(F1575:F1578)) Or whatever the column and rows are. So I need a combination so that instead of =Application.Sum... I get =SUM(colrow:colrow).

Can I impose on your (or anyone else) one more time to illustrate that. I'm a wiz at Access VBA, but Excel VBA baffles me.

Answer 3

To insert a SUM formula, in the above code at 2 lines in lieu of Application.Sum, the following may be used:

In lieu of:

Range("A" & lEndRow + 1).Offset(0, 1) = Application.Sum(Range("A" & lStartRow & ":A" & lEndRow).Offset(0, 1))

use:

Range("B" & lEndRow + 1) = "=SUM(B" & lStartRow & ":B" & lEndRow & ")"

In lieu of:

Range("A" & lEndRow).Offset(0, 1) = Application.Sum(Range("A" & lStartRow & ":A" & lEndRow - 1).Offset(0, 1))

use:

Range("B" & lEndRow) = "=SUM(B" & lStartRow & ":B" & lEndRow - 1 & ")"

Answer 4

Updated the same code to add totals in the blank row which is added:

Sub InsertRows()

  Dim lastRow As Long

  Dim rowPtr As Long

  Dim lStartRow As Long, lEndRow As Long

  lastRow = Range("A" & Rows.count).End(xlUp).Row

  lEndRow = lastRow + 1

  For rowPtr = lastRow To 2 Step -1

    If Not IsEmpty(Range("A" & rowPtr)) Then

      If Range("A" & rowPtr) <> Range("A" & rowPtr - 1) Then

        Range("A" & rowPtr).EntireRow.Insert

        lStartRow = rowPtr + 1

        Range("A" & lEndRow + 1).Offset(0, 1) = Application.Sum(Range("A" & lStartRow & ":A" & lEndRow).Offset(0, 1))

        lEndRow = lStartRow - 1

      End If

    End If

  Next

    lStartRow = 1

    Range("A" & lEndRow).Offset(0, 1) = Application.Sum(Range("A" & lStartRow & ":A" & lEndRow - 1).Offset(0, 1))

End Sub

Start row = 1, totals have been inserted in blank rows of column B.

Regards,

Amit Tandon

Answer 5

Re:  sum grouped ranges

Insert the blank rows and try this...

'---

Sub InsertSubTotalsInBlankCells()

  Dim lastRow  As Long

  Dim rowPtr   As Long

  Dim tempRw   As Long

  Dim startRow As Long

  lastRow = Range("A" & Rows.Count).End(xlUp).Row

  startRow = 2

  tempRw = startRow

  For rowPtr = startRow To lastRow + 1

    If IsEmpty(Range("A" & rowPtr)) Then

      Range("A" & rowPtr).Formula = "=""Subtotal: "" & SubTotal(9," & _

            Range(Cells(tempRw, 1), Cells(rowPtr - 1, 1)).Address & ")"

      tempRw = rowPtr + 1

    End If

  Next

End Sub

'---

Jim Cone

Portland, Oregon USA