My need now is similar, so I thought that I would try modify Rudi's original code and learn along the way. What I need is to examine Column B and when there is a change, insert two blank rows. In the first of the two newly inserted rows, I need a total in BOLD font in Columns K, Q and R. When I try to compile the code below, I receive a Compile Error Dialog that states "End if without Block If". The "End if" statement is then highlight. As stated previously, the original code from Rudi ran perfect--so I must have messed something up in the revision---
Code: Select all
Sub CreateTotals()
Dim lRow As Long
Dim Rng As Range
Dim i As Integer
Application.ScreenUpdating = False
For lRow = Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then Rows(lRow).Resize(2).EntireRow.Insert
Next lRow
For Each Rng In Columns("B").SpecialCells(xlCellTypeConstants).Areas
i = i + 1
If i = 1 Then
Rng.Offset(1).Resize(2).EntireRow.Delete
Else
With Rng.Offset(Rng.Rows.Count).Cells(1).Offset(0, 9)
.FormulaR1C1 = "=SUM(R[-1]C:R[-" & Rng.Rows.Count & "]C)"
.Font.Bold = True
With Rng.Offset(Rng.Rows.Count).Cells(1).Offset(0, 16)
.FormulaR1C1 = "=SUM(R[-1]C:R[-" & Rng.Rows.Count & "]C)"
.Font.Bold = True
With Rng.Offset(Rng.Rows.Count).Cells(1).Offset(0, 17)
.FormulaR1C1 = "=SUM(R[-1]C:R[-" & Rng.Rows.Count & "]C)"
.Font.Bold = True
End With
End If
Next Rng
Application.ScreenUpdating = True
End Sub