Sub Withdrawals()
Application.ScreenUpdating = False
Debug.Print Time()
' Define table columns
Const cTgtPC As String = "C" 'Column with Target fund percentages
Const cOldBal As String = "D" 'Column with Old fund balances
Const cOldPC As String = "E" 'Column with Old fund percentages
Const cTgtRebal As String = "H" 'Column with Target rebalance delta
Const cWDAmt As String = "I" 'Column with Withdrawal amounts
'Define named ranges
Const nTotalOld As String = "TotOld" 'Name of Old fund total cell
Const nWDAmt As String = "WDAmt" 'Name of withdrawal amount cell
Const nTotAdj As String = "TotAdj" 'Name of adjusted total cell
Dim row As Long 'Row number
Dim i As Long 'Number of funds over the target %
Dim Val As Double 'The withdrawal value
Dim TgtPct As Double 'Sum of target %s
i = 0 'Zero the count
Val = 0 'Zero withdrawal
TgtPct = 0 'Zero the target %
With ActiveSheet
'Check for out of range withdrawal amounts
'Macropod's code
'.Range(nWDAmt).Value = Abs(.Range(nWDAmt).Value)
'If .Range(nWDAmt).Value > .Range(nTotalOld).Value Then
' MsgBox "Insufficient Funds!", vbExclamation: Exit Sub
'End If
'My modified code
Debug.Print "WDAmt = " & .Range(nWDAmt).Value
Debug.Print "WDAmt = " & .Range(nWDAmt).Value
Select Case .Range(nWDAmt).Value
Case Is > .Range(nTotalOld).Value
MsgBox "Withdrawal amount too large", vbExclamation: Exit Sub
Case Is < 0
MsgBox "Withdrawal < 0", vbExclamation: Exit Sub
End Select
'Collect data from the index fund rows in use
For row = 7 To 9
'Check each index fund for an excess balance
If .Range(cTgtRebal & row).Value < 0 Then
'Sum the $ of each index fund with excess balance
Val = Val + .Range(cOldBal & row).Value
'Sum the % of each index fund with excess balance
TgtPct = TgtPct + .Range(cTgtPC & row).Value
'Update counter for index funds with excess balance
i = i + 1
End If
Next row
'Calculate the required target % variance to be applied to each of the original % figures
'Basically, Val minus WDAmt, divided by TotAdj, then subtract TgtPct. This gives the
'required overall % adjustment. Divide the result by the count of adjustment items to get
'the required individual index fund % adjustment.
TgtPct = ((Val - .Range(nWDAmt).Value) / .Range(nTotAdj).Value - TgtPct) / i
'Update the index fund rows in use
For row = 7 To 9
'If the actual % is greater than the target %, calculate the withdrawal value
If .Range(cOldPC & row).Value > .Range(cTgtPC & row).Value Then
'Sum the required target % variance and the original %,
'then multiply by TotAdj and subtract the old index fund $
Val = (.Range(cTgtPC & row).Value + TgtPct) * .Range(nTotAdj).Value - .Range(cOldBal & row).Value
Else
Val = 0
End If
'If the calculated withdrawal $ exceeds the total withdrawal $,
'reduce the calculated withdrawal $ accordingly
If Val < -.Range(nWDAmt).Value Then Val = -.Range(nWDAmt).Value
'Avoid potential implied credits arising out of small WDAmt
If Val > 0 Then Val = 0
'Output the result in column I rounded to dollars and cents
.Range(cWDAmt & row).Value = Format(Val, "$#,##0.00")
Next row
'Calculate the allocated $
Val = 0
For row = 7 To 9
Val = Val + .Range(cWDAmt & row).Value
Next row
Val = -(Val + .Range(nWDAmt).Value)
'If Val <> 0 then a remainder of withdrawal needs to be allocated
If Val <> 0 Then
For row = 7 To 9
'Check each index fund omitted from first round
If .Range(cWDAmt & row).Value = 0 Then TgtPct = TgtPct + .Range(cTgtPC & row).Value
Next row
For row = 7 To 9
'Apportion Val between index funds omitted from first round
If .Range(cWDAmt & row).Value = 0 Then
.Range(cWDAmt & row).Value = Format(Val * .Range(cTgtPC & row).Value / TgtPct, "$#,##0.00")
End If
Next row
End If
End With
Application.ScreenUpdating = True
End Sub
