Create multiple blank rows and adding a formula in the first newly created blank row

Hi,

This maybe really simple but it is driving me potty as I can't seem to find the solution.

I have a spreadsheet that has numerous duplicated lines.

Current Spreadsheet
A B C
1 A Dave £5.00
2 A Dave £3.00
3 B Steve £2.00
4 B Steve £5.00
5 B Steve £8.00
6 C Sharon £2.00
7 C Sharon £1.00
8 C Sharon £10.00

What I would like to do is to group the duplicated lines together that has a specific code , split the different duplicated codes by inserting three blank rows between them on the same worksheet and then adding a subtotal in a selected column within the first newly created blank row.


What I hope to achieve
A B C
1 A Dave £5.00
2 A Dave £3.00
3 Total £8.00
4
5
6 B Steve £2.00
7 B Steve £5.00
8 B Steve £8.00
9 Total £13.00
10
11
12 C Sharon £2.00
13 C Sharon £1.00
14 C Sharon £10.00
15 Total £13.00


I am able to group and add the blankrows with

Sub InsertBlankRows()

'Insert Blank Rows Between Duplicates

Dim Duplicate As Worksheet
Set Duplicate = ThisWorkbook.Worksheets("Duplicates")

Duplicate.Activate

Dim LastRow As Long, i As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = LastRow To 3 Step -1
    If Cells(i, "S") <> Cells(i - 1, "S") Then
        Rows(i & ":" & i + 2).Insert
    End If
Next i

End Sub

But for the life of me I can't add the sum totals in the newly acquire blank line and it is driving me insane. I've got this far with selecting the blank lines in column N

Sub test()
Dim r As Long
    On Error Resume Next
    r = Cells(Rows.Count, "m").End(xlUp).Row
    Range("n2:n" & r).SpecialCells(xlCellTypeBlanks).Select
    
End Sub

But I have no idea how to sum the values above the selected cell although it selecting the 3 blank lines instead of the 1

Any help will be greatly appreciated as normal

Try this:

Sub test()

Dim B As Long
Dim MyRNG As Range

Set MyRNG = Range("N:N").SpecialCells(xlConstants, 1)
            
For B = 1 To MyRNG.Areas.Count
    With MyRNG.Areas(B).Cells(MyRNG.Areas(B).Cells.Count).Offset(1)
        .Formula = "=SUM(" & MyRNG.Areas(B).Address(False, False) & ")"
    End With
    With MyRNG.Areas(B).Cells(MyRNG.Areas(B).Cells.Count).Offset(1)
        .Font.Bold = True
    End With
    With MyRNG.Areas(B).Cells(MyRNG.Areas(B).Cells.Count).Offset(1)
        .NumberFormat = "£#,##0.00"
    End With
Next B
   
End Sub

Kosherboy,

You absolute genius!

I have no idea how this works but it does

Thank you

You're very welcome

Sorry Kosherboy, how do I add the 'total' in the column next to the formula?

Sorry, should learn to read from the top down.

Thanks again

if i helped resolve your question please click the "*" button to the left of my post for reputation.

Thanks!