Grouping Unique Records inside of Groups

[SB123]

Hello,

This is my first post here, so thanks for the effort in putting up the site.

I am having some trouble with a particular area in my code. I am stumped as to how to move forward and was hoping that someone could redirect me or provide some guidance. I am trying to split balances both as a weighted average as well as stacked one on top of the other. The balances then need to be carried forward into the next structure/group so that the process can be repeated.

I have built the idea on the sheet, but I haven't been able to make the logic work in VB. I keep getting stuck at accumulating balances when they are being stacked. See Column 11 in the Array NoteHold for reference.

Because this is a bit hard to describe, I am also attaching my working Excel file. The code is below and is also in the Excel File. The Sheet is a good place to see how the code should work. I apologize for the Long Code. I have been trying different methods and have possibly left unnecessary information in the code.

[VBA]Sub Loss()

Dim DefaultValue As Double
Notes = 13 'represents "All Notes"
DefaultValue = Range("i23") 'Value of the Family (Portfolio Value)
ReDim NoteHold(Notes, 13)

'Load Notes in the same Family-Loan Structure
j = 1
For i = 1 To Notes
If Cells(5 + i, 4) & Cells(5 + i, 5) = Range("e24") Then 'Modify as Family-Note combo in DB
NoteHold(j, 1) = Cells(5 + i, 4) & Cells(5 + i, 5) 'Loan Name (Constant)
NoteHold(j, 2) = "1" & Cells(5 + i, 13) 'Note Name (Constant)
NoteHold(j, 3) = Cells(5 + i, 9) 'Note Amount (Constant)
NoteHold(j, 4) = Len(Cells(5 + i, 13)) 'Note Length (Constant)
NoteHold(j, 8) = j 'Note Count (Constant)
j = j + 1
End If
Next

'Fill in Overall Loan Structure
For i = 1 To Notes
MaxLen = Application.WorksheetFunction.Max(NoteHold(i, 4), MaxLen)
Next

For i = 1 To Notes
For j = 1 To MaxLen
If j <= NoteHold(i, 4) Then
NoteHold(i, 9) = NoteHold(i, 2)
Else
NoteHold(i, 9) = Left(NoteHold(i, 9), j) & IIf(j / 2 <> Round(j / 2, 0), "A", "1")
End If
Next
LoanBal = NoteHold(i, 3) + LoanBal
Next

'Load Initial Loss and Loan Balance
LoanLoss = Application.WorksheetFunction.Max(LoanBal - DefaultValue, 0)
For n = 1 To Notes
NoteHold(n, 5) = LoanBal
NoteHold(n, 7) = LoanLoss
Next

'Loop through the Notes Structures where MaxLen is the length of the full Note Name
For i = 1 To MaxLen + 1
If i / 2 = Round(i / 2, 0) Then

'Splits Loans Horizontally to pass Total Bal of "Aplha" for "i"
For n = 1 To Notes
NoteHold(n, 10) = NoteHold(n, 10) & Mid(NoteHold(n, 9), i, 1)
SumNoteBal = 0
For m = 1 To Notes
If NoteHold(n, 10) = Left(NoteHold(m, 9), i) Then
SumNoteBal = NoteHold(m, 3) + SumNoteBal
End If
Next
NoteHold(n, 6) = SumNoteBal
Next

''---------------------------------STUCK HERE----------------------

'Counts Notes in "i-Alpha" position
For n = 1 To Notes
For m = 1 To Notes
NoteCount = 0
If Left(NoteHold(n, 10), i) <> Left(NoteHold(m, 9), i) Then
NoteCount = NoteCount + 1
End If
NoteHold(n, 12) = NoteCount
Next
Next

For n = 1 To Notes
For m = n To NoteHold(n, 12)
If Left(NoteHold(n, 10), i) = Left(NoteHold(m, 9), i) Then
CumNoteBal = NoteHold(n, 5) - NoteHold(m, 3)
End If

Next
NoteHold(n, 11) = CumNoteBal
Next

''-----------------------------------------------------------------


'Applies the Loss
For n = 1 To Notes
NoteHold(n, 7) = Application.WorksheetFunction.Min _
(Application.WorksheetFunction.Max _
(NoteHold(n, 7) - (NoteHold(n, 5) - NoteHold(n, 11)), 0), NoteHold(n, 6))


' NoteHold(n, 7) = Application.WorksheetFunction.Max _
' (Application.WorksheetFunction.Min _
' (NoteHold(n, 6), NoteHold(n, 7) - (NoteHold(n, 5) - NoteHold(n, 11))), 0)
Next

'Set New Note Allocation for Loan Group
For n = 1 To Notes
NoteHold(n, 5) = NoteHold(n, 6)
Next
Else

'Counting "Numbers" in the Note Structure for given position
For n = 1 To Notes
NoteHold(n, 10) = NoteHold(n, 10) & Mid(NoteHold(n, 9), i, 1)
SumNoteBal = 0
For m = 1 To Notes
If NoteHold(n, 10) = Left(NoteHold(m, 9), i) Then
SumNoteBal = NoteHold(m, 3) + SumNoteBal
End If
Next
NoteHold(n, 6) = SumNoteBal
Next

'Vertical splitting of Losses at given position
For n = 1 To Notes
NoteHold(n, 7) = NoteHold(n, 7) * NoteHold(n, 6) / NoteHold(n, 5)
Next

'Set New Note Allocation for Loan Group
For n = 1 To Notes
NoteHold(n, 5) = NoteHold(n, 6)
Next
End If


For n = 1 To Notes
Cells(n + 51, i + 5).Value = NoteHold(n, 7)
Next
Next

End Sub
[/VBA]

Thanks in Advance,
Steve

[Bob Phillips]

What is the data that you will start with, in terms of that spreadsheet, and what do you want to end with?

[SB123]

The starting data will be a list of Loans defined by the combination of Column D and E. the example shows a single loan, but there could be more. This Loan is selected by filling range("E24"). Also, columns I and N would be needed. Column I would represent individual balances for Notes, and Column N would be the would be the Note Position in the Capital Stack. I have illustrated this particular Capital Stack on the right.

The possibilities for the Capital Structure would start with A and could continue alphabetically. The "Alphas" would signify horizontal splits. The "Numbers" would signify the vertical splits and could continue indefinitely. The Alphas and Numbers alternate back and forth as is shown in the example.

Finally, there is a total loss on the loan that needs to be captured. It is signified by range("!24"), but it is also calculate in the macro. The end result from the Losses should represent the same figures that are currently appearing on the sheet in Range("K6:K18"). I have shown how these are calculated on the sheet in different ways in range("M25:N46"). The final resulting array could be placed in Range("L6:L18") and would match what is next to it in K.

Sorry if I was too vague earlier.

Thanks Again,
Steve

[Bob Phillips]

This doesn't produce the same results as yours, but I fail to see where some of yours come from

[vba]

Sub ProcessData()
Dim Lastrow As Long
Dim i As Long
Dim Target As Worksheet
Dim idx As Long
Dim results As Variant
Dim prev As String
Dim nBalance As Double
Dim nLoss As Double

Set Target = Worksheets("Drawing")
With Worksheets("Sheet1")

Lastrow = .Columns("E").Find("Total").Row - 2 '.Cells(.Rows.Count, "E").End(xlUp).Row
ReDim results(1 To 3, 1 To 1)
prev = ""
For i = 6 To Lastrow

If .Cells(i, "E").Value <> .Cells(i - 1, "E").Value Then

idx = idx + 1
nBalance = Application.SumIf(.Columns("E"), .Cells(i, "E").Value, .Columns("I"))
nLoss = Application.SumIf(.Columns("E"), .Cells(i, "E").Value, .Columns("K"))
ReDim Preserve results(1 To 3, 1 To idx)
results(1, idx) = .Cells(i, "E").Value
results(2, idx) = nBalance
results(3, idx) = nLoss
End If

If .Cells(i, "F").Value <> "" Then

If .Cells(i, "E").Value <> .Cells(i - 1, "E").Value Or _
.Cells(i, "F").Value <> .Cells(i - 1, "F").Value Then

idx = idx + 1
nBalance = .Evaluate("SUMPRODUCT(--(E6:E" & Lastrow & "=""" & .Cells(i, "E").Value & """)" & _
",--(F6:F" & Lastrow & "=""" & .Cells(i, "F").Value & """)" & _
",I6:I" & Lastrow & ")")
nLoss = .Evaluate("SUMPRODUCT(--(E6:E" & Lastrow & "=""" & .Cells(i, "E").Value & """)" & _
",--(F6:F" & Lastrow & "=""" & .Cells(i, "F").Value & """)" & _
",K6:K" & Lastrow & ")")
ReDim Preserve results(1 To 3, 1 To idx)
results(1, idx) = .Cells(i, "F").Value
results(2, idx) = nBalance
results(3, idx) = nLoss
End If
End If

If .Cells(i, "G").Value <> "" Then

If .Cells(i, "E").Value <> .Cells(i - 1, "E").Value Or _
.Cells(i, "F").Value <> .Cells(i - 1, "F").Value Or _
.Cells(i, "G").Value <> .Cells(i - 1, "G").Value Then

idx = idx + 1
nBalance = .Evaluate("SUMPRODUCT(--(E6:E" & Lastrow & "=""" & .Cells(i, "E").Value & """)" & _
",--(F6:F" & Lastrow & "=""" & .Cells(i, "F").Value & """)" & _
",--(G6:G" & Lastrow & "=" & .Cells(i, "G").Value & ")" & _
",I6:I" & Lastrow & ")")
nLoss = .Evaluate("SUMPRODUCT(--(E6:E" & Lastrow & "=""" & .Cells(i, "E").Value & """)" & _
",--(F6:F" & Lastrow & "=""" & .Cells(i, "F").Value & """)" & _
",--(G6:G" & Lastrow & "=" & .Cells(i, "G").Value & ")" & _
",K6:K" & Lastrow & ")")
ReDim Preserve results(1 To 3, 1 To idx)
results(1, idx) = .Cells(i, "F").Value & .Cells(i, "G").Value
results(2, idx) = nBalance
results(3, idx) = nLoss
End If
End If

If .Cells(i, "H").Value <> "" Then

If .Cells(i, "E").Value <> .Cells(i - 1, "E").Value Or _
.Cells(i, "F").Value <> .Cells(i - 1, "F").Value Or _
.Cells(i, "G").Value <> .Cells(i - 1, "G").Value Or _
.Cells(i, "H").Value <> .Cells(i - 1, "H").Value Then

idx = idx + 1
nBalance = .Evaluate("SUMPRODUCT(--(E6:E" & Lastrow & "=""" & .Cells(i, "E").Value & """)" & _
",--(F6:F" & Lastrow & "=""" & .Cells(i, "F").Value & """)" & _
",--(G6:G" & Lastrow & "=" & .Cells(i, "G").Value & ")" & _
",--(H6:H" & Lastrow & "=""" & .Cells(i, "H").Value & """)" & _
",I6:I" & Lastrow & ")")
nLoss = .Evaluate("SUMPRODUCT(--(E6:E" & Lastrow & "=""" & .Cells(i, "E").Value & """)" & _
",--(F6:F" & Lastrow & "=""" & .Cells(i, "F").Value & """)" & _
",--(G6:G" & Lastrow & "=" & .Cells(i, "G").Value & ")" & _
",--(H6:H" & Lastrow & "=""" & .Cells(i, "H").Value & """)" & _
",K6:K" & Lastrow & ")")
ReDim Preserve results(1 To 3, 1 To idx)
results(1, idx) = .Cells(i, "F").Value & .Cells(i, "G").Value & .Cells(i, "H").Value
results(2, idx) = nBalance
results(3, idx) = nLoss
End If
End If
Next i

Target.Range("A1").Resize(UBound(results, 2) - LBound(results, 2) + 1, UBound(results, 1) - LBound(results, 1) + 1) = _
Application.Transpose(results)
End With
End Sub
[/vba]

[SB123]

I ran your code through the model, and it came up with a few problems. I was able to use some of the code that you provided to make a fix, so thank you for giving me some ideas.

Sincerely,
Steve