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
精彩评论