Investment Model Allocation based upon Percentage and Dollar Amounts

L

luckyajr

Board Regular
Joined
Mar 21, 2011
Messages
96
Hi,

I am working on a project in which I need to create an investment allocation spreadsheet. The idea is that there can be anywhere from 2 to 6 investment accounts, each with varying dollar amounts. Each account is then then defined as either a "taxable" or "tax deferred" account. From there, I want to apply those accounts to an investment model with targeted asset class percentages (e.g. 8% to Large Cap, 12% to Emerging Markets, etc. totalling to 100%). Each asset class will either be allocated to a "taxable" or a "tax deferred" account(s), and one asset class will be allocated to both registrations (due to percentage differences). Next, based upon the asset class percentage and the total portfolio amount, the trade amount to be placed for the asset class is then formulated.

This next part is where I am stuck. I want to create a formula (or macro) that will dictate which particular account(s) the asset class should be traded to, where everything ends up allocated to the investment model.

So, as an example, there could be a scenario where I have 3 accounts (1 "taxable" and 2 "tax deferred" accounts) that will all be considered "one bucket of money" and I want to allocate those accounts to the investment model which is based upon different asset classes. Each asset class has a defined $ trade amount and is also assigned to an account registration ("taxable"/"tax deferred" or "both").

I'm not sure if I explained this well or not. Apologies if I didn't. Thank you in advance, I sincerely appreciate it.
 
Sort by date Sort by votes
Hi Dave,

Man, I feel as though I'm getting more and more ignorant as this goes on. I'm still not too hip on this VBA code thing. I'm not sure where to paste it in the code. Will you just simply copy the entire code so I don't have to 'edit' the current one I have? Thanks!!
 
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Ok I'll blow off a bit more web space. PM is short for private message :) Dave
Code: 
Sub FillF5()
Dim LargeTemp2 As Double, Cnt2 As Integer, Cnt3 As Integer
Dim LargeTemp As Double, Cnt As Integer, Temptot As Double
Dim TotTax As Double, Lastrow As Integer, Counter As Integer
Dim Cnt2Temp As Integer, CntTemp As Integer, RemTot As Double
Dim RemGrs As Double, Cnt4 As Integer, CellCnt As Integer
Dim Cnt5 As Integer
'fee in Sheets("Sheet2").Range("A" & 1).Value
'"G" has current balance of untraded amount
'"I" has total trade fee
' "J" has # of trades

'include all accts
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'clear previous results
'*******Caution clears E7:j22 and G25:J & lastrow
Sheets("Sheet1").Range("G25:J" & Lastrow).ClearContents
Sheets("Sheet1").Range("E7:J22").ClearContents

'transfer acct total to "G" for current balance
For Cnt2 = 25 To Lastrow
Sheets("Sheet1").Range("G" & Cnt2).Value = Sheets("Sheet1").Range("C" & Cnt2).Value
Next Cnt2
'gross amts
For Cnt3 = 7 To 22
Sheets("Sheet1").Range("E" & Cnt3).Value = Sheets("Sheet1").Range("A" & Cnt3).Value * _
                                            Sheets("Sheet1").Range("B" & 1).Value
Next Cnt3

For Counter = 1 To 2
Select Case Counter
'taxable/tax deferred
Case 1: Temptot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A30"), Worksheets("Sheet1").Range("G25:G" & Lastrow)): _
Case 2: Temptot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A31"), Worksheets("Sheet1").Range("G25:G" & Lastrow))
End Select
Do While Temptot > 1
LargeTemp = 0
LargeTemp2 = 0
If Counter = 1 Then
'current balance taxable
For Cnt2 = 25 To Lastrow
If Sheets("Sheet1").Range("B" & Cnt2).Value = "Taxable" Then
If LargeTemp2 < Sheets("Sheet1").Range("G" & Cnt2).Value Then
LargeTemp2 = Sheets("Sheet1").Range("G" & Cnt2).Value
Cnt2Temp = Cnt2
End If
End If
Next Cnt2
'grs amounts taxable
For Cnt = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt).Value = "Taxable" Then
If LargeTemp < Sheets("Sheet1").Range("e" & Cnt).Value And _
LargeTemp2 >= LargeTemp Then
LargeTemp = Sheets("Sheet1").Range("e" & Cnt).Value
CntTemp = Cnt
End If
End If
Next Cnt
'current balance tax defer
Else
For Cnt2 = 25 To Lastrow
If Sheets("Sheet1").Range("B" & Cnt2).Value = "Tax Deferred" Then
If LargeTemp2 < Sheets("Sheet1").Range("G" & Cnt2).Value Then
LargeTemp2 = Sheets("Sheet1").Range("G" & Cnt2).Value
Cnt2Temp = Cnt2
End If
End If
Next Cnt2
'grs amounts tax defer
For Cnt = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt).Value = "Tax Deferred" Then
If LargeTemp < Sheets("Sheet1").Range("e" & Cnt).Value And _
LargeTemp2 >= LargeTemp Then
LargeTemp = Sheets("Sheet1").Range("e" & Cnt).Value
CntTemp = Cnt
End If
End If
Next Cnt
End If

If LargeTemp = 0 Or LargeTemp2 - LargeTemp <= 0 Then
Exit Do
End If

'insert acct #
Sheets("Sheet1").Range("F" & CntTemp).Value = Sheets("Sheet1").Range("A" & Cnt2Temp).Value
If CntTemp <> 22 Then 'no fee for #22
'total fee (fee amt in Sheets("Sheet2").Range("A" & 1).Value)
Sheets("Sheet1").Range("I" & Cnt2Temp).Value = _
Sheets("Sheet1").Range("I" & Cnt2Temp).Value + Sheets("Sheet2").Range("A" & 1).Value
'net trade amt
Sheets("Sheet1").Range("e" & CntTemp).Value = Sheets("Sheet1").Range("e" & CntTemp).Value - _
                                               Sheets("Sheet2").Range("A" & 1).Value
End If
'current balnce
Sheets("Sheet1").Range("G" & Cnt2Temp).Value = LargeTemp2 - LargeTemp
'trade cnter
Sheets("Sheet1").Range("j" & Cnt2Temp).Value = _
Sheets("Sheet1").Range("j" & Cnt2Temp).Value + 1
Temptot = Temptot - LargeTemp
MsgBox "View"
Loop
Next Counter

'********multi trade taxable/tax defer
For Counter = 1 To 2
Select Case Counter
Case 1: RemTot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A30"), Worksheets("Sheet1").Range("G25:G" & Lastrow)): _
Case 2: RemTot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A31"), Worksheets("Sheet1").Range("G25:G" & Lastrow))
End Select

Do While RemTot > 1
RemGrs = 0
For Cnt4 = 7 To 22
'tot grs taxable remaining
If Counter = 1 Then
If Sheets("Sheet1").Range("C" & Cnt4).Value = "Taxable" Then
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
End If
'tot grs tax defer remaining
Else
If Sheets("Sheet1").Range("C" & Cnt4).Value = "Tax Deferred" Then
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
End If
End If
Next Cnt4

If RemGrs = 0 Then
Exit Do
End If

CellCnt = 6
For Cnt5 = 25 To Lastrow
If Sheets("Sheet1").Range("G" & Cnt5).Value > 0 Then
If Sheets("Sheet1").Range("C" & Cnt4).Value = Sheets("Sheet1").Range("B" & Cnt5).Value Then
If Sheets("Sheet1").Range("G" & Cnt5).Value <= RemGrs Then

If Cnt4 <> 22 Then 'no fee for #22
'total fee
Sheets("Sheet1").Range("I" & Cnt5).Value = _
Sheets("Sheet1").Range("I" & Cnt5).Value + Sheets("Sheet2").Range("A" & 1).Value
If Sheets("Sheet1").Range("e" & Cnt4).Value >= Sheets("Sheet1").Range("G" & Cnt5).Value Then
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                           Sheets("Sheet1").Range("G" & Cnt5).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
       "(" & Sheets("Sheet1").Range("G" & Cnt5).Value - Sheets("Sheet2").Range("A" & 1).Value & ")"
RemTot = RemTot - Sheets("Sheet1").Range("g" & Cnt5).Value
Sheets("Sheet1").Range("G" & Cnt5).Value = 0
Else
'current balance remaining
Sheets("Sheet1").Range("G" & Cnt5).Value = Sheets("Sheet1").Range("G" & Cnt5).Value - _
                                           Sheets("Sheet1").Range("e" & Cnt4).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
        "(" & Sheets("Sheet1").Range("e" & Cnt4).Value - Sheets("Sheet2").Range("A" & 1).Value & ")"
RemTot = RemTot - Sheets("Sheet1").Range("e" & Cnt4).Value
Sheets("Sheet1").Range("e" & Cnt4).Value = 0
End If
Else
If Sheets("Sheet1").Range("e" & Cnt4).Value > Sheets("Sheet1").Range("G" & Cnt5).Value Then
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                             Sheets("Sheet1").Range("G" & Cnt5).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
                                            "(" & Sheets("Sheet1").Range("G" & Cnt5).Value & ")"
RemTot = RemTot - Sheets("Sheet1").Range("G" & Cnt5).Value
Sheets("Sheet1").Range("G" & Cnt5).Value = 0
Else
'current balance remaining
Sheets("Sheet1").Range("G" & Cnt5).Value = Sheets("Sheet1").Range("G" & Cnt5).Value - _
                                           Sheets("Sheet1").Range("e" & Cnt4).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
                                            "(" & Sheets("Sheet1").Range("e" & Cnt4).Value & ")"
RemTot = RemTot - Sheets("Sheet1").Range("e" & Cnt4).Value
Sheets("Sheet1").Range("e" & Cnt4).Value = 0
End If
End If
CellCnt = CellCnt + 1
MsgBox "View"
'trade cnt
Sheets("Sheet1").Range("j" & Cnt5).Value = _
Sheets("Sheet1").Range("j" & Cnt5).Value + 1
End If
End If
End If
Next Cnt5
If Sheets("Sheet1").Range("e" & Cnt4).Value = 0 Then
Sheets("Sheet1").Range("e" & Cnt4).Value = "MultiTrade"
End If
Loop
Next Counter

'multi allocate to both
For Cnt4 = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
Next Cnt4

CellCnt = 6
For Cnt5 = 25 To Lastrow
If Sheets("Sheet1").Range("G" & Cnt5).Value <> 0 Then
'trade cnt
Sheets("Sheet1").Range("j" & Cnt5).Value = _
              Sheets("Sheet1").Range("j" & Cnt5).Value + 1
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                           Sheets("Sheet1").Range("G" & Cnt5).Value
If Cnt4 <> 22 Then 'no fee for #22
'trade fee
Sheets("Sheet1").Range("I" & Cnt5).Value = _
Sheets("Sheet1").Range("I" & Cnt5).Value + Sheets("Sheet2").Range("A" & 1).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
    "(" & Sheets("Sheet1").Range("G" & Cnt5).Value - Sheets("Sheet2").Range("A" & 1).Value & ")"
Else
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
                                         "(" & Sheets("Sheet1").Range("G" & Cnt5).Value & ")"
End If
Sheets("Sheet1").Range("G" & Cnt5).Value = 0
CellCnt = CellCnt + 1
MsgBox "View"
End If
Next Cnt5
If Sheets("Sheet1").Range("e" & Cnt4).Value = 0 Then
Sheets("Sheet1").Range("e" & Cnt4).Value = "MultiTrade"
End If
End Sub
 
Upvote 0
Thanks for posting the code. Seems to be working better now.
Trial this:
Keep the same totals in C25:28, then change allocation factor (B5) to "40" and run the code.
E8 Displays "No Trade" on mine even though it is a "multitrade". The value of the E8 is actually "-0.01".
Also trial same totals in C25:28 with allocation factor of "30". In E9 we have a "0.01".
Same thing when allocation factor is "80", E8 displays "0.01".
So, yes, in most cases the code is working efficiently, while in other scenarios it is not.
Thoughts?
Look forward to hearing back from you. Thanks.
 
Upvote 0
Trial F6. It is that fractionation thing causing problems. Anyways, where do you want the current total, number of trades and trade fees (G, I, J:25 etc)? Thought about the allocate to both ticker thing. Trial this in sheet1!D8 with 40% allocation (with 4 accts)
Code: 
=IF(C8="Allocate to Both*","DFLVX/DTMMX",IF(C8="Tax Deferred","DFLVX","DTMMX"))
You can VBA a split and then add the ticker to the output. How do you want the multi allocate to both output to look (ie acct#(Ticker:NetTrade)? Here's F6. F7 might be a wrap.
Dave
ps. How does that No Trade get into E7:E22?
Code: 
Sub FillF6()
Dim LargeTemp2 As Double, Cnt2 As Integer, Cnt3 As Integer
Dim LargeTemp As Double, Cnt As Integer, Temptot As Double
Dim TotTax As Double, Lastrow As Integer, Counter As Integer
Dim Cnt2Temp As Integer, CntTemp As Integer, RemTot As Double
Dim RemGrs As Double, Cnt4 As Integer, CellCnt As Integer
Dim Cnt5 As Integer
'fee in Sheets("Sheet2").Range("A" & 1).Value
'"G" has current balance of untraded amount
'"I" has total trade fee
' "J" has # of trades
'exit if impossible (A23 is sum of % = 1)
If Sheets("Sheet1").Range("A" & 23).Value > 1 Then
MsgBox "More than %100 allocated. Exit!"
Exit Sub
End If

'include all accts
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'clear previous results
'*******Caution clears E7:j22 and G25:J & lastrow
Sheets("Sheet1").Range("G25:J" & Lastrow).ClearContents
Sheets("Sheet1").Range("E7:J22").ClearContents

'transfer acct total to "G" for current balance
For Cnt2 = 25 To Lastrow
Sheets("Sheet1").Range("G" & Cnt2).Value = Sheets("Sheet1").Range("C" & Cnt2).Value
Next Cnt2
'gross amts
For Cnt3 = 7 To 22
If Sheets("Sheet1").Range("A" & Cnt3).Value <> "0%" Then
Sheets("Sheet1").Range("E" & Cnt3).Value = Format(Sheets("Sheet1").Range("A" & Cnt3).Value * _
                                            Sheets("Sheet1").Range("B" & 1).Value, "currency")
Else
Sheets("Sheet1").Range("E" & Cnt3).Value = 0
End If
Next Cnt3

For Counter = 1 To 2
Select Case Counter
'taxable/tax deferred
Case 1: Temptot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A30"), Worksheets("Sheet1").Range("G25:G" & Lastrow)): _
Case 2: Temptot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A31"), Worksheets("Sheet1").Range("G25:G" & Lastrow))
End Select
Do While Temptot > 1
LargeTemp = 0
LargeTemp2 = 0
If Counter = 1 Then
'current balance taxable
For Cnt2 = 25 To Lastrow
If Sheets("Sheet1").Range("B" & Cnt2).Value = "Taxable" Then
If LargeTemp2 < Sheets("Sheet1").Range("G" & Cnt2).Value Then
LargeTemp2 = Sheets("Sheet1").Range("G" & Cnt2).Value
Cnt2Temp = Cnt2
End If
End If
Next Cnt2
'grs amounts taxable
For Cnt = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt).Value = "Taxable" Then
If LargeTemp < Sheets("Sheet1").Range("e" & Cnt).Value And _
LargeTemp2 >= LargeTemp Then
LargeTemp = Sheets("Sheet1").Range("e" & Cnt).Value
CntTemp = Cnt
End If
End If
Next Cnt
'current balance tax defer
Else
For Cnt2 = 25 To Lastrow
If Sheets("Sheet1").Range("B" & Cnt2).Value = "Tax Deferred" Then
If LargeTemp2 < Sheets("Sheet1").Range("G" & Cnt2).Value Then
LargeTemp2 = Sheets("Sheet1").Range("G" & Cnt2).Value
Cnt2Temp = Cnt2
End If
End If
Next Cnt2
'grs amounts tax defer
For Cnt = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt).Value = "Tax Deferred" Then
If LargeTemp < Sheets("Sheet1").Range("e" & Cnt).Value And _
LargeTemp2 >= LargeTemp Then
LargeTemp = Sheets("Sheet1").Range("e" & Cnt).Value
CntTemp = Cnt
End If
End If
Next Cnt
End If
If LargeTemp = 0 Or LargeTemp2 - LargeTemp <= 0 Then
Exit Do
End If

'insert acct #
Sheets("Sheet1").Range("F" & CntTemp).Value = Sheets("Sheet1").Range("A" & Cnt2Temp).Value
If CntTemp <> 22 Then 'no fee for #22
'total fee (fee amt in Sheets("Sheet2").Range("A" & 1).Value)
Sheets("Sheet1").Range("I" & Cnt2Temp).Value = _
Sheets("Sheet1").Range("I" & Cnt2Temp).Value + Sheets("Sheet2").Range("A" & 1).Value
'net trade amt
Sheets("Sheet1").Range("e" & CntTemp).Value = _
                             Format(Sheets("Sheet1").Range("e" & CntTemp).Value - _
                               Sheets("Sheet2").Range("A" & 1).Value, "currency")
End If
'current balnce
Sheets("Sheet1").Range("G" & Cnt2Temp).Value = LargeTemp2 - LargeTemp
'trade cnter
Sheets("Sheet1").Range("j" & Cnt2Temp).Value = _
Sheets("Sheet1").Range("j" & Cnt2Temp).Value + 1
Temptot = Temptot - LargeTemp
'MsgBox "View"
Loop
Next Counter

'********multi trade taxable/tax defer
For Counter = 1 To 2
Select Case Counter
Case 1: RemTot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A30"), Worksheets("Sheet1").Range("G25:G" & Lastrow)): _
Case 2: RemTot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A31"), Worksheets("Sheet1").Range("G25:G" & Lastrow))
End Select

Do While RemTot > 1
RemGrs = 0
For Cnt4 = 7 To 22
'tot grs taxable remaining
If Counter = 1 Then
If Sheets("Sheet1").Range("C" & Cnt4).Value = "Taxable" Then
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
End If
'tot grs tax defer remaining
Else
If Sheets("Sheet1").Range("C" & Cnt4).Value = "Tax Deferred" Then
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
End If
End If
Next Cnt4
If RemGrs = 0 Then
Exit Do
End If

CellCnt = 6
For Cnt5 = 25 To Lastrow
If Sheets("Sheet1").Range("G" & Cnt5).Value > 0 Then
If Sheets("Sheet1").Range("C" & Cnt4).Value = Sheets("Sheet1").Range("B" & Cnt5).Value Then
If Sheets("Sheet1").Range("G" & Cnt5).Value <= RemGrs Then
If Cnt4 <> 22 Then 'no fee for #22
'total fee
Sheets("Sheet1").Range("I" & Cnt5).Value = _
Sheets("Sheet1").Range("I" & Cnt5).Value + Sheets("Sheet2").Range("A" & 1).Value
If Sheets("Sheet1").Range("e" & Cnt4).Value >= Sheets("Sheet1").Range("G" & Cnt5).Value Then
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                           Sheets("Sheet1").Range("G" & Cnt5).Value, "currency")
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
       "(" & Format(Sheets("Sheet1").Range("G" & Cnt5).Value - Sheets("Sheet2").Range("A" & 1).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("g" & Cnt5).Value
Sheets("Sheet1").Range("G" & Cnt5).Value = 0
Else
'current balance remaining
Sheets("Sheet1").Range("G" & Cnt5).Value = Sheets("Sheet1").Range("G" & Cnt5).Value - _
                                           Sheets("Sheet1").Range("e" & Cnt4).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
        "(" & Format(Sheets("Sheet1").Range("e" & Cnt4).Value - Sheets("Sheet2").Range("A" & 1).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("e" & Cnt4).Value
Sheets("Sheet1").Range("e" & Cnt4).Value = 0
End If
Else
If Sheets("Sheet1").Range("e" & Cnt4).Value > Sheets("Sheet1").Range("G" & Cnt5).Value Then
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                             Sheets("Sheet1").Range("G" & Cnt5).Value, "currency")
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
                                            "(" & Format(Sheets("Sheet1").Range("G" & Cnt5).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("G" & Cnt5).Value
Sheets("Sheet1").Range("G" & Cnt5).Value = 0
Else
'current balance remaining
Sheets("Sheet1").Range("G" & Cnt5).Value = Sheets("Sheet1").Range("G" & Cnt5).Value - _
                                           Sheets("Sheet1").Range("e" & Cnt4).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
                                            "(" & Format(Sheets("Sheet1").Range("e" & Cnt4).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("e" & Cnt4).Value
Sheets("Sheet1").Range("e" & Cnt4).Value = 0
End If
End If
CellCnt = CellCnt + 1
'trade cnt
Sheets("Sheet1").Range("j" & Cnt5).Value = _
Sheets("Sheet1").Range("j" & Cnt5).Value + 1
End If
End If
End If
Next Cnt5
If Sheets("Sheet1").Range("e" & Cnt4).Value < 0.1 Then
Sheets("Sheet1").Range("e" & Cnt4).Value = "MultiTrade"
End If
Loop
Next Counter

'multi allocate to both
For Cnt4 = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
Next Cnt4

CellCnt = 6
For Cnt5 = 25 To Lastrow
If Sheets("Sheet1").Range("G" & Cnt5).Value <> 0 Then
'trade cnt
Sheets("Sheet1").Range("j" & Cnt5).Value = _
              Sheets("Sheet1").Range("j" & Cnt5).Value + 1
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                           Sheets("Sheet1").Range("G" & Cnt5).Value, "currency")
If Cnt4 <> 22 Then 'no fee for #22
'trade fee
Sheets("Sheet1").Range("I" & Cnt5).Value = _
Sheets("Sheet1").Range("I" & Cnt5).Value + Sheets("Sheet2").Range("A" & 1).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
    "(" & Format(Sheets("Sheet1").Range("G" & Cnt5).Value - Sheets("Sheet2").Range("A" & 1).Value, "currency") & ")"
Else
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
                                         "(" & Sheets("Sheet1").Range("G" & Cnt5).Value & ")"
End If
Sheets("Sheet1").Range("G" & Cnt5).Value = 0
CellCnt = CellCnt + 1
'MsgBox "View"
End If
Next Cnt5
If Sheets("Sheet1").Range("e" & Cnt4).Value < 0.1 Then
Sheets("Sheet1").Range("e" & Cnt4).Value = "MultiTrade"
End If
End Sub
 
Upvote 0
So far, the actual coding is working very well! I've trialed many different account types and values and it seems to be allocating accordingly, except for just a couple situations.
Trial This...

C25: $355,122.22
C26: $425,111.67
(Both "Tax Deferred")
B5: 90
Then run the code.
E18 should not have a trade, because the asset class has 0% associated with it. (it should display "NO TRADE")
"NO TRADE" is displayed if the asset class allocation is 0%. This will occur for rows 18:21 when B5>=90.
Other than this issue, the code seems to be working perfectly.

For the ticker symbol and formatting issue, what do you mean exactly that "you can VBA a split and then add the ticker to the output"?.
I don't have a problem with both ticker symbols being outputted to the "Allocate to Both*" cell, but there still needs to be respect given to which accounts will be trading which symbols.
What I mean by this (and you may already understand) is in the below example in cell D8, "DFLVX/DTMMX" will be displayed. So that tells us obvoiusly that those tickers will be used. However, it doesn't tell us which accounts (and the total amount) that will be traded to those tickers. So someone using this spreadsheet may be confused. Because it's only half useful to know which ticker your allocating, if you don't know which account to allocate the specific ticker to.
It would be perfectly fine if both symbols were referenced as you explained below (in cell D8) as long as the specific account number and total and ticker were referenced more specifically further to the right.
The best format I can think of now is "acct#(Ticker:NetTrade)" I think that would work just fine.

Thanks!!
 
Upvote 0
"Anyways, where do you want the current total, number of trades and trade fees (G, I, J:25 etc)?" In the scenario above note that Sheet1!A23 doesn't equal %100 and Sheet1!C22 is allocated Taxable not Tax Deferred ie. that stuff don't add up and that's the cause of the wrong output. I've adjusted the code to provide a warning when this occurs. Will post the full code when I have all the info. Dave
ps. How does that "No Trade" get into E7:E22?
pps. Will the cell format become to large with the addition of the ticker symbol?
 
Last edited:
Upvote 0
Hi Dave,

So, apologies, I inadvertently gave you a non-updated version of my spreadsheet that did not have the correct asset allocation formulas for A7:A22. I have since updated this.
When I applied the code to the updated percentages (which now actually total 100%) the code kicks back an error saying that its more than %100 allocated or something like that.
Thoughts?
If the current total, number of trades, and trade fees, could just be extended into the next columns starting at E and moving to the right that would be great, instead of starting in G.
I don't think the cell format will be too large, but I'm not sure until I see it. And I don't have a more efficient idea than that method right now anyway, so I figure its worth a shot. Look forward to hearing back. THanks!!
 
Upvote 0
The code only returns that message when A23 is larger than %100.
A non-updated spreadsheet makes things somewhat difficult. Trial this with the 4 accts, 40% allocatation and the Sheet1!D8 formula from before. Dave
Code: 
Sub FillF7()
Dim LargeTemp2 As Double, Cnt2 As Integer, Cnt3 As Integer
Dim LargeTemp As Double, Cnt As Integer, Temptot As Double
Dim TotTax As Double, Lastrow As Integer, Counter As Integer
Dim Cnt2Temp As Integer, CntTemp As Integer, RemTot As Double
Dim RemGrs As Double, Cnt4 As Integer, CellCnt As Integer
Dim Cnt5 As Integer, SplitStr As Variant, TickStr As String
'fee in Sheets("Sheet2").Range("A" & 1).Value
'"E25:etc" has current balance of untraded amount
'"F25:etc" has # of trades
'"G25:etc" has total trade fee
'exit if impossible (A23 is sum of % = 1)
If Sheets("Sheet1").Range("A" & 23).Value > 1 Then
MsgBox "More than %100 allocated. Exit!"
Exit Sub
End If

'include all accts
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'clear previous results
'*******Caution clears E7:j22 and G25:F & lastrow
Sheets("Sheet1").Range("E25:G" & Lastrow).ClearContents
Sheets("Sheet1").Range("E7:J22").ClearContents

'transfer acct total to "E" for current balance
For Cnt2 = 25 To Lastrow
Sheets("Sheet1").Range("E" & Cnt2).Value = Sheets("Sheet1").Range("C" & Cnt2).Value
Next Cnt2
'gross amts
For Cnt3 = 7 To 22
If Sheets("Sheet1").Range("A" & Cnt3).Value <> "0%" Then
Sheets("Sheet1").Range("E" & Cnt3).Value = Format(Sheets("Sheet1").Range("A" & Cnt3).Value * _
                                            Sheets("Sheet1").Range("B" & 1).Value, "currency")
Else
Sheets("Sheet1").Range("E" & Cnt3).Value = 0
End If
Next Cnt3

For Counter = 1 To 2
Select Case Counter
'taxable/tax deferred
Case 1: Temptot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A30"), Worksheets("Sheet1").Range("E25:E" & Lastrow))
Case 2: Temptot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A31"), Worksheets("Sheet1").Range("E25:E" & Lastrow))
End Select
Do While Temptot > 1
LargeTemp = 0
LargeTemp2 = 0
If Counter = 1 Then
'current balance taxable
For Cnt2 = 25 To Lastrow
If Sheets("Sheet1").Range("B" & Cnt2).Value = "Taxable" Then
If LargeTemp2 < Sheets("Sheet1").Range("E" & Cnt2).Value Then
LargeTemp2 = Sheets("Sheet1").Range("E" & Cnt2).Value
Cnt2Temp = Cnt2
End If
End If
Next Cnt2
'grs amounts taxable
For Cnt = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt).Value = "Taxable" Then
If LargeTemp < Sheets("Sheet1").Range("e" & Cnt).Value And _
LargeTemp2 >= LargeTemp Then
LargeTemp = Sheets("Sheet1").Range("e" & Cnt).Value
CntTemp = Cnt
End If
End If
Next Cnt
'current balance tax defer
Else
For Cnt2 = 25 To Lastrow
If Sheets("Sheet1").Range("B" & Cnt2).Value = "Tax Deferred" Then
If LargeTemp2 < Sheets("Sheet1").Range("E" & Cnt2).Value Then
LargeTemp2 = Sheets("Sheet1").Range("E" & Cnt2).Value
Cnt2Temp = Cnt2
End If
End If
Next Cnt2
'grs amounts tax defer
For Cnt = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt).Value = "Tax Deferred" Then
If LargeTemp < Sheets("Sheet1").Range("e" & Cnt).Value And _
LargeTemp2 >= LargeTemp Then
LargeTemp = Sheets("Sheet1").Range("e" & Cnt).Value
CntTemp = Cnt
End If
End If
Next Cnt
End If
If LargeTemp = 0 Or LargeTemp2 - LargeTemp <= 0 Then
Exit Do
End If

'insert acct #
Sheets("Sheet1").Range("F" & CntTemp).Value = Sheets("Sheet1").Range("A" & Cnt2Temp).Value
If CntTemp <> 22 Then 'no fee for #22
'total fee (fee amt in Sheets("Sheet2").Range("A" & 1).Value)
Sheets("Sheet1").Range("G" & Cnt2Temp).Value = _
Sheets("Sheet1").Range("G" & Cnt2Temp).Value + Sheets("Sheet2").Range("A" & 1).Value
'net trade amt
Sheets("Sheet1").Range("e" & CntTemp).Value = _
                             Format(Sheets("Sheet1").Range("e" & CntTemp).Value - _
                               Sheets("Sheet2").Range("A" & 1).Value, "currency")
End If
'current balnce
Sheets("Sheet1").Range("E" & Cnt2Temp).Value = LargeTemp2 - LargeTemp
'trade cnter
Sheets("Sheet1").Range("F" & Cnt2Temp).Value = _
Sheets("Sheet1").Range("F" & Cnt2Temp).Value + 1
Temptot = Temptot - LargeTemp
'MsgBox "View"
Loop
Next Counter

'********multi trade taxable/tax defer
For Counter = 1 To 2
Select Case Counter
Case 1: RemTot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A30"), Worksheets("Sheet1").Range("E25:E" & Lastrow)): _
Case 2: RemTot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A31"), Worksheets("Sheet1").Range("E25:E" & Lastrow))
End Select

Do While RemTot > 1
RemGrs = 0
For Cnt4 = 7 To 22
'tot grs taxable remaining
If Counter = 1 Then
If Sheets("Sheet1").Range("C" & Cnt4).Value = "Taxable" Then
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
End If
'tot grs tax defer remaining
Else
If Sheets("Sheet1").Range("C" & Cnt4).Value = "Tax Deferred" Then
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
End If
End If
Next Cnt4
If RemGrs = 0 Then
Exit Do
End If

CellCnt = 6
For Cnt5 = 25 To Lastrow
If Sheets("Sheet1").Range("E" & Cnt5).Value > 0 Then
If Sheets("Sheet1").Range("C" & Cnt4).Value = Sheets("Sheet1").Range("B" & Cnt5).Value Then
If Sheets("Sheet1").Range("E" & Cnt5).Value <= RemGrs Then
If Cnt4 <> 22 Then 'no fee for #22
'total fee
Sheets("Sheet1").Range("G" & Cnt5).Value = _
Sheets("Sheet1").Range("G" & Cnt5).Value + Sheets("Sheet2").Range("A" & 1).Value
If Sheets("Sheet1").Range("e" & Cnt4).Value >= Sheets("Sheet1").Range("E" & Cnt5).Value Then
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                           Sheets("Sheet1").Range("E" & Cnt5).Value, "currency")
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
"(" & Format(Sheets("Sheet1").Range("E" & Cnt5).Value - _
        Sheets("Sheet2").Range("A" & 1).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("E" & Cnt5).Value
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
Sheets("Sheet1").Range("F" & Cnt5).Value + 1
Sheets("Sheet1").Range("E" & Cnt5).Value = 0
Else
If Sheets("Sheet1").Range("e" & Cnt4).Value <> 0 Then
'current balance remaining
Sheets("Sheet1").Range("E" & Cnt5).Value = Sheets("Sheet1").Range("E" & Cnt5).Value - _
                                           Sheets("Sheet1").Range("e" & Cnt4).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
        "(" & Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                Sheets("Sheet2").Range("A" & 1).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("e" & Cnt4).Value
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
Sheets("Sheet1").Range("F" & Cnt5).Value + 1
Sheets("Sheet1").Range("e" & Cnt4).Value = 0
End If
End If
Else
If Sheets("Sheet1").Range("e" & Cnt4).Value >= Sheets("Sheet1").Range("E" & Cnt5).Value Then
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                        Sheets("Sheet1").Range("E" & Cnt5).Value, "currency")
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
                "(" & Format(Sheets("Sheet1").Range("E" & Cnt5).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("E" & Cnt5).Value
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
Sheets("Sheet1").Range("F" & Cnt5).Value + 1
Sheets("Sheet1").Range("E" & Cnt5).Value = 0
Else
If Sheets("Sheet1").Range("e" & Cnt4).Value <> 0 Then
'current balance remaining
Sheets("Sheet1").Range("E" & Cnt5).Value = Sheets("Sheet1").Range("E" & Cnt5).Value - _
                                           Sheets("Sheet1").Range("e" & Cnt4).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
                "(" & Format(Sheets("Sheet1").Range("e" & Cnt4).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("e" & Cnt4).Value
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
Sheets("Sheet1").Range("F" & Cnt5).Value + 1
Sheets("Sheet1").Range("e" & Cnt4).Value = 0
End If
End If
End If
'MsgBox "view"
CellCnt = CellCnt + 1

End If
End If
End If

Next Cnt5
If Sheets("Sheet1").Range("e" & Cnt4).Value < 0.1 Then
Sheets("Sheet1").Range("e" & Cnt4).Value = "MultiTrade"
End If
Loop
Next Counter

'multi allocate to both
For Cnt4 = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt4).Value = "Allocate to Both*" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
Next Cnt4
If Cnt4 = 23 Then
MsgBox "Allocation doesn't equal input!"
Exit Sub
End If

CellCnt = 6
For Cnt5 = 25 To Lastrow
If Sheets("Sheet1").Range("E" & Cnt5).Value <> 0 Then
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
              Sheets("Sheet1").Range("F" & Cnt5).Value + 1
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                        Sheets("Sheet1").Range("E" & Cnt5).Value, "currency")
On Error Resume Next
SplitStr = Split(Sheets("Sheet1").Range("D" & Cnt4).Value, "/")
If Sheets("Sheet1").Range("B" & Cnt5).Value = "Tax Deferred" Then
TickStr = SplitStr(0)
Else
TickStr = SplitStr(1)
End If

If Cnt4 <> 22 Then 'no fee for #22
'trade fee
Sheets("Sheet1").Range("G" & Cnt5).Value = _
Sheets("Sheet1").Range("G" & Cnt5).Value + Sheets("Sheet2").Range("A" & 1).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
    "(" & TickStr & ":" & Format(Sheets("Sheet1").Range("E" & Cnt5).Value _
           - Sheets("Sheet2").Range("A" & 1).Value, "currency") & ")"
Else
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = Sheets("Sheet1").Range("A" & Cnt5).Value & _
            "(" & TickStr & ":" & Sheets("Sheet1").Range("E" & Cnt5).Value & ")"
End If
Sheets("Sheet1").Range("E" & Cnt5).Value = 0
CellCnt = CellCnt + 1
'MsgBox "View"
End If
Next Cnt5
If Sheets("Sheet1").Range("e" & Cnt4).Value < 0.1 Then
Sheets("Sheet1").Range("e" & Cnt4).Value = "MultiTrade"
End If
End Sub
 
Upvote 0
The more than 100% error is fixed now. It was a formatting issue. I also updated the Ticker symbol formulas as you described in column sheet1!D so that it will display both tickers if it's Allocate to Both*. I have been trialing several different scenarios and all seem to working perfectly, EXCEPT for this one:
Trial This...

C25: $355,122.22 (Tax Deferred)
C26: $425,111.67 (Tax Deferred)
C27: $185,000 (Taxable)
C28: $89,000 (Taxable)
B5: "40".

When I trial this it gets about halfway through and then stops working and the program goes into "Not Responding" mode, causing me to shut down Excel. Is this happening to you??

The other thing is for the "Multitrade" accounts, I would like the numbers to be formatted as "###-######" (e.g. 453-257980) if possible.

We are so close I can taste it! (How's that one for a bad cliche?)

Thanks as always and look forward to hearing back Dave!
 
Upvote 0
Whoops! A bit of a logic error. Here's the fix with formatted acct number. It makes your ouput colums real wide. Dave
Code: 
Sub FillF8()
Dim LargeTemp2 As Double, Cnt2 As Integer, Cnt3 As Integer
Dim LargeTemp As Double, Cnt As Integer, Temptot As Double
Dim TotTax As Double, Lastrow As Integer, Counter As Integer
Dim Cnt2Temp As Integer, CntTemp As Integer, RemTot As Double
Dim RemGrs As Double, Cnt4 As Integer, CellCnt As Integer
Dim Cnt5 As Integer, SplitStr As Variant, TickStr As String
'fee in Sheets("Sheet2").Range("A" & 1).Value
'"E25:etc" has current balance of untraded amount
'"F25:etc" has # of trades
'"G25:etc" has total trade fee
'exit if impossible (A23 is sum of % = 1)
If Sheets("Sheet1").Range("A" & 23).Value > 1 Then
MsgBox "More than %100 allocated. Exit!"
Exit Sub
End If

'include all accts
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'clear previous results
'*******Caution clears E7:j22 and G25:F & lastrow
Sheets("Sheet1").Range("E25:G" & Lastrow).ClearContents
Sheets("Sheet1").Range("E7:J22").ClearContents

'transfer acct total to "E" for current balance
For Cnt2 = 25 To Lastrow
Sheets("Sheet1").Range("E" & Cnt2).Value = Sheets("Sheet1").Range("C" & Cnt2).Value
Next Cnt2
'gross amts
For Cnt3 = 7 To 22
If Sheets("Sheet1").Range("A" & Cnt3).Value <> "0%" Then
Sheets("Sheet1").Range("E" & Cnt3).Value = Format(Sheets("Sheet1").Range("A" & Cnt3).Value * _
                                            Sheets("Sheet1").Range("B" & 1).Value, "currency")
Else
Sheets("Sheet1").Range("E" & Cnt3).Value = 0
End If
Next Cnt3

For Counter = 1 To 2
Select Case Counter
'taxable/tax deferred
Case 1: Temptot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A30"), Worksheets("Sheet1").Range("E25:E" & Lastrow))
Case 2: Temptot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A31"), Worksheets("Sheet1").Range("E25:E" & Lastrow))
End Select
Do While Temptot > 1
LargeTemp = 0
LargeTemp2 = 0
If Counter = 1 Then
'current balance taxable
For Cnt2 = 25 To Lastrow
If Sheets("Sheet1").Range("B" & Cnt2).Value = "Taxable" Then
If LargeTemp2 < Sheets("Sheet1").Range("E" & Cnt2).Value Then
LargeTemp2 = Sheets("Sheet1").Range("E" & Cnt2).Value
Cnt2Temp = Cnt2
End If
End If
Next Cnt2
'grs amounts taxable
For Cnt = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt).Value = "Taxable" Then
If LargeTemp < Sheets("Sheet1").Range("e" & Cnt).Value And _
LargeTemp2 >= Sheets("Sheet1").Range("e" & Cnt).Value Then
LargeTemp = Sheets("Sheet1").Range("e" & Cnt).Value
CntTemp = Cnt
End If
End If
Next Cnt
'current balance tax defer
Else
For Cnt2 = 25 To Lastrow
If Sheets("Sheet1").Range("B" & Cnt2).Value = "Tax Deferred" Then
If LargeTemp2 < Sheets("Sheet1").Range("E" & Cnt2).Value Then
LargeTemp2 = Sheets("Sheet1").Range("E" & Cnt2).Value
Cnt2Temp = Cnt2
End If
End If
Next Cnt2
'grs amounts tax defer
For Cnt = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt).Value = "Tax Deferred" Then
If LargeTemp < Sheets("Sheet1").Range("e" & Cnt).Value And _
LargeTemp2 >= Sheets("Sheet1").Range("e" & Cnt).Value Then
LargeTemp = Sheets("Sheet1").Range("e" & Cnt).Value
CntTemp = Cnt
End If
End If
Next Cnt
End If
If LargeTemp = 0 Or LargeTemp2 - LargeTemp <= 0 Then
Exit Do
End If

'insert acct #
Sheets("Sheet1").Range("F" & CntTemp).Value = _
                  Format(Sheets("Sheet1").Range("A" & Cnt2Temp).Value, "000-000000")
If CntTemp <> 22 Then 'no fee for #22
'total fee (fee amt in Sheets("Sheet2").Range("A" & 1).Value)
Sheets("Sheet1").Range("G" & Cnt2Temp).Value = _
Sheets("Sheet1").Range("G" & Cnt2Temp).Value + Sheets("Sheet2").Range("A" & 1).Value
'net trade amt
Sheets("Sheet1").Range("e" & CntTemp).Value = _
                             Format(Sheets("Sheet1").Range("e" & CntTemp).Value - _
                               Sheets("Sheet2").Range("A" & 1).Value, "currency")
End If
'current balnce
Sheets("Sheet1").Range("E" & Cnt2Temp).Value = LargeTemp2 - LargeTemp
'trade cnter
Sheets("Sheet1").Range("F" & Cnt2Temp).Value = _
Sheets("Sheet1").Range("F" & Cnt2Temp).Value + 1
Temptot = Temptot - LargeTemp
'MsgBox "View"
Loop
Next Counter

'********multi trade taxable/tax defer
For Counter = 1 To 2
Select Case Counter
Case 1: RemTot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A30"), Worksheets("Sheet1").Range("E25:E" & Lastrow)): _
Case 2: RemTot = _
Application.WorksheetFunction.SumIf(Worksheets("Sheet1").Range("B25:B" & Lastrow), _
Worksheets("Sheet2").Range("A31"), Worksheets("Sheet1").Range("E25:E" & Lastrow))
End Select

Do While RemTot > 1
RemGrs = 0
For Cnt4 = 7 To 22
'tot grs taxable remaining
If Counter = 1 Then
If Sheets("Sheet1").Range("C" & Cnt4).Value = "Taxable" Then
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
End If
'tot grs tax defer remaining
Else
If Sheets("Sheet1").Range("C" & Cnt4).Value = "Tax Deferred" Then
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
End If
End If
Next Cnt4
If RemGrs = 0 Then
Exit Do
End If

CellCnt = 6
For Cnt5 = 25 To Lastrow
If Sheets("Sheet1").Range("E" & Cnt5).Value > 0 Then
If Sheets("Sheet1").Range("C" & Cnt4).Value = Sheets("Sheet1").Range("B" & Cnt5).Value Then
If Sheets("Sheet1").Range("E" & Cnt5).Value <= RemGrs Then
If Cnt4 <> 22 Then 'no fee for #22
'total fee
Sheets("Sheet1").Range("G" & Cnt5).Value = _
Sheets("Sheet1").Range("G" & Cnt5).Value + Sheets("Sheet2").Range("A" & 1).Value
If Sheets("Sheet1").Range("e" & Cnt4).Value >= Sheets("Sheet1").Range("E" & Cnt5).Value Then
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                           Sheets("Sheet1").Range("E" & Cnt5).Value, "currency")
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = _
                           Format(Sheets("Sheet1").Range("A" & Cnt5).Value, "000-000000") & _
                        "(" & Format(Sheets("Sheet1").Range("E" & Cnt5).Value - _
                     Sheets("Sheet2").Range("A" & 1).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("E" & Cnt5).Value
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
Sheets("Sheet1").Range("F" & Cnt5).Value + 1
Sheets("Sheet1").Range("E" & Cnt5).Value = 0
Else
If Sheets("Sheet1").Range("e" & Cnt4).Value <> 0 Then
'current balance remaining
Sheets("Sheet1").Range("E" & Cnt5).Value = Sheets("Sheet1").Range("E" & Cnt5).Value - _
                                           Sheets("Sheet1").Range("e" & Cnt4).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = _
                     Format(Sheets("Sheet1").Range("A" & Cnt5).Value, "000-000000") & _
                    "(" & Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                Sheets("Sheet2").Range("A" & 1).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("e" & Cnt4).Value
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
Sheets("Sheet1").Range("F" & Cnt5).Value + 1
Sheets("Sheet1").Range("e" & Cnt4).Value = 0
End If
End If
Else
If Sheets("Sheet1").Range("e" & Cnt4).Value >= Sheets("Sheet1").Range("E" & Cnt5).Value Then
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                        Sheets("Sheet1").Range("E" & Cnt5).Value, "currency")
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = _
                  Format(Sheets("Sheet1").Range("A" & Cnt5).Value, "000-000000") & _
                "(" & Format(Sheets("Sheet1").Range("E" & Cnt5).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("E" & Cnt5).Value
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
Sheets("Sheet1").Range("F" & Cnt5).Value + 1
Sheets("Sheet1").Range("E" & Cnt5).Value = 0
Else
If Sheets("Sheet1").Range("e" & Cnt4).Value <> 0 Then
'current balance remaining
Sheets("Sheet1").Range("E" & Cnt5).Value = Sheets("Sheet1").Range("E" & Cnt5).Value - _
                                           Sheets("Sheet1").Range("e" & Cnt4).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = _
                   Format(Sheets("Sheet1").Range("A" & Cnt5).Value, "000-000000") & _
                "(" & Format(Sheets("Sheet1").Range("e" & Cnt4).Value, "currency") & ")"
RemTot = RemTot - Sheets("Sheet1").Range("e" & Cnt4).Value
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
Sheets("Sheet1").Range("F" & Cnt5).Value + 1
Sheets("Sheet1").Range("e" & Cnt4).Value = 0
End If
End If
End If
'MsgBox "view"
CellCnt = CellCnt + 1
End If
End If
End If
Next Cnt5
If Sheets("Sheet1").Range("e" & Cnt4).Value < 0.1 Then
Sheets("Sheet1").Range("e" & Cnt4).Value = "MultiTrade"
End If
Loop
Next Counter

'multi allocate to both
For Cnt4 = 7 To 22
If Sheets("Sheet1").Range("F" & Cnt4).Value = "" And _
Sheets("Sheet1").Range("C" & Cnt4).Value = "Allocate to Both*" Then
RemGrs = Sheets("Sheet1").Range("E" & Cnt4).Value
Exit For
End If
Next Cnt4
If Cnt4 = 23 Then
MsgBox "Allocation doesn't equal input!"
Exit Sub
End If

CellCnt = 6
For Cnt5 = 25 To Lastrow
If Sheets("Sheet1").Range("E" & Cnt5).Value <> 0 Then
'trade cnt
Sheets("Sheet1").Range("F" & Cnt5).Value = _
              Sheets("Sheet1").Range("F" & Cnt5).Value + 1
'net remaining
Sheets("Sheet1").Range("e" & Cnt4).Value = Format(Sheets("Sheet1").Range("e" & Cnt4).Value - _
                                        Sheets("Sheet1").Range("E" & Cnt5).Value, "currency")
On Error Resume Next
SplitStr = Split(Sheets("Sheet1").Range("D" & Cnt4).Value, "/")
If Sheets("Sheet1").Range("B" & Cnt5).Value = "Tax Deferred" Then
TickStr = SplitStr(0)
Else
TickStr = SplitStr(1)
End If

If Cnt4 <> 22 Then 'no fee for #22
'trade fee
Sheets("Sheet1").Range("G" & Cnt5).Value = _
Sheets("Sheet1").Range("G" & Cnt5).Value + Sheets("Sheet2").Range("A" & 1).Value
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = _
                   Format(Sheets("Sheet1").Range("A" & Cnt5).Value, "000-000000") & _
             "(" & TickStr & ":" & Format(Sheets("Sheet1").Range("E" & Cnt5).Value _
           - Sheets("Sheet2").Range("A" & 1).Value, "currency") & ")"
Else
'insert acct #
Sheets("Sheet1").Cells(Cnt4, CellCnt) = _
                 Format(Sheets("Sheet1").Range("A" & Cnt5).Value, "000-000000") & _
            "(" & TickStr & ":" & Sheets("Sheet1").Range("E" & Cnt5).Value & ")"
End If
Sheets("Sheet1").Range("E" & Cnt5).Value = 0
CellCnt = CellCnt + 1
'MsgBox "View"
End If
Next Cnt5
If Sheets("Sheet1").Range("e" & Cnt4).Value < 0.1 Then
Sheets("Sheet1").Range("e" & Cnt4).Value = "MultiTrade"
End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Chart Source Data Query
Replies
0
Views
382
M10Ant
M
DDRA Steampunk
  • Question
Extract dollar amount from text in range, then total those amounts on summary
Replies
5
Views
1K
Micron
M
F
  • Question
Calculate percentages of dollar amounts on a table that can adjust to more or less accounts.
Replies
0
Views
337
frkre05
F
K
  • Question
Student Choice
Replies
5
Views
2K
Peter_SSs
Peter_SSs
L
  • Question
VBA works on work PC but not home PC
Replies
3
Views
2K
rollis13
rollis13

Forum statistics

Threads
1,216,028
Messages
6,128,399
Members
449,447
Latest member
M V Arun

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top