Split Delimited nth Data into New Rows/columns

Sub test()
    Dim a, b, i As Long, m, n As Long, ttl As Double
    a = Sheets("sheet1").Cells(1).CurrentRegion.Value
    ReDim b(1 To Rows.Count, 1 To 3)
    With CreateObject("VBScript.RegExp")
        .Global = True: .MultiLine = True
        For i = 1 To UBound(a, 1)
            .Pattern = "^ *(-?\d+(\.\d+)?)[\r\n]+(.*[\r\n]+){2} *(\d{2})/(\d{2})/(\d{4})"
            If .test(a(i, 2)) Then
                n = n + 1: b(n, 1) = a(i, 1)
                For Each m In .Execute(a(i, 2))
                    n = n + 1
                    b(n, 2) = DateSerial(m.submatches(5), _
                        m.submatches(4), m.submatches(3))
                    b(n, 3) = Val(m.submatches(0))
                    ttl = ttl + b(n, 3)
                Next
                n = n + 1: b(n, 1) = "Ttl"
                b(n, 3) = ttl: ttl = 0: n = n + 1
            End If
        Next
    End With
    With Sheets.Add.Cells(1).Resize(, 3)
        .Value = [{"#'S","Date","Payments"}]
        .Rows(2).Resize(n).Value = b
        .EntireColumn.AutoFit
    End With
End Sub

Edit: Just realized the dates, if they need to be serial dates.