开发者

Insert row with total under each group

I need to insert a row with a total and a page break under each group.

I tried the following to insert the row, however it inserted more than one row, when I want just one.

Sub macro()
Dim sh1 As Worksheet
Dim i As Long, lastrow1 As Long

Set sh1 = Worksheets("Sheet1")     
lastrow1 = s开发者_JAVA技巧h1.Cells.SpecialCells(xlCellTypeLastCell).Row

For i = 1 To lastrow1

   If sh1.Cells(i, "A").Value = "sell" Then
      sh1.Cells(i, "A").EntireRow.Insert
   End If
Next i
End Sub


I'm no expert on VBA but it sure looks like your code will insert a row every time it finds "sell" hence multiple rows inserted.

Try adding a break after you insert the row to get you out of the for loop.

hope this helps.
AH Note, in VBA Exit For is used to break out of for loops so your code would be

Set sh1 = Worksheets("Sheet1")     
lastrow1 = sh1.Cells.SpecialCells(xlCellTypeLastCell).Row

For i = 1 To lastrow1
    If sh1.Cells(i, "A").Value = "sell" Then
       sh1.Cells(i, "A").EntireRow.Insert
       Exit For
    End If
Next i
End Sub


This will work with more than two different strings in column A

Sub InsertTotals()

    Dim i As Long
    Dim lLastRow As Long
    Dim sh1 As Worksheet

    Set sh1 = ActiveWorkbook.Worksheets("Sheet1")

    lLastRow = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row

    For i = lLastRow + 1 To 2 Step -1
        If sh1.Cells(i, 1).Value <> sh1.Cells(i - 1, 1).Value Then
            sh1.Cells(i, 1).EntireRow.Insert
        End If
    Next i

End Sub


Here's another method using Excel's built-in subtotals. It's not for inserting rows per se, but if your ultimate goal is to subtotal column B, this may be more suitable.

Sub InsertSubtotals()

    Dim rTransactions As Range
    Dim sh1 As Worksheet

    Set sh1 = ActiveWorkbook.Worksheets("Sheet1")
    sh1.Range("A1").EntireRow.Insert
    sh1.Range("A1:B1").Value = Array("Type", "Amount")

    Set rTransactions = sh1.Range("A1", sh1.Cells(sh1.Rows.Count, 1).End(xlUp))

    rTransactions.Resize(, 2).Subtotal 1, xlSum, Array(2)

End Sub
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜