VBA Excel Subtotal Dynamic Ranges Not Working

Question

I have this snippet of code that I've borrowed from other post and edited(or at least tried) that I'm trying to use to subtotal some dynamic ranges. I use a key column with 0's, 1's, and 2's. I want the code to add all the coorosponding columns across from each 1 until it hits a 2 and then put the subtotal in the column with the 2. Currently, my code keeps running backwards so it is putting the wrong subtotals in. Below is a snippet of my code.

'count all 1's in each section till next 2 for subtotaling each section
With Range("P13:P" & lRow1)
Set rFind = .Find(What:=2, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                  Lookat:=xlWhole, SearchDirection:=xlNext, searchFormat:=False)
If Not rFind Is Nothing Then
    s = rFind.Address
    Do
        Set r1 = rFind
        Set rFind = .FindNext(rFind)
        If rFind.Address = s Then
            Set rFind = .Cells(.Cells.Count)
            r1.Offset(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), r1.Offset(, -5)))
            Exit Sub
        End If
        r1.Offset(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), rFind.Offset(, -5)))
    Loop While rFind.Address <> s
End If
End With

Even now that I type this question out I'm thinking I should take a different approach. My code places a 0 at each blank line and I currently have it set to place a 0 on the line above the 1st 1. With that, I could maybe find the 1st 0 then add all the 1's till i reach a 2 then find the next 0 and so forth. Does that make sense?

Below is a picture of what the macro is currently producing.

Answer 1

You can actually do this with a formula

=IF(P3=2,SUMIF($P$1:P2,1,$K$1:K2)-SUMIF($P$1:P2,2,$K$1:K2),"")

in each cell in K where there is a 2 in column P. Could use VBA to insert this.

---

Here's a straight VBA solution:

Sub x()

Dim r As Range

For Each r In Range("K:K").SpecialCells(xlCellTypeConstants).Areas
    r(r.Count + 1).Value = Application.Sum(r)
Next r

End Sub