Libreoffice financial macros

goals.vb

REM  *****  BASIC  *****

Function VLOOKUP(SearchValue As Variant, CellRange As Object, Column As Integer, Mode As Integer) As Variant
	Dim svc As Object
	Dim arg AS Variant
	
    svc = createUnoService("com.sun.star.sheet.FunctionAccess")
    arg = Array(SearchValue, CellRange, Column, Mode)

    VLOOKUP = svc.callFunction("VLOOKUP", arg)
End Function

Function MATCH(SearchValue As Variant, CellRange As Object, Mode As Integer) As Variant
	Dim svc As Object
	Dim arg AS Variant
	
    svc = createUnoService("com.sun.star.sheet.FunctionAccess")
    arg = Array(SearchValue, CellRange, Mode)

    MATCH = svc.callFunction("MATCH", arg)
End Function

Function MIN(X As Double, Y As Double) As Double
	Dim svc As Object
	Dim arg AS Variant
	
    svc = createUnoService("com.sun.star.sheet.FunctionAccess")
    arg = Array(X, Y)

    MIN = svc.callFunction("MIN", arg)
End Function

Function MAX(X As Double, Y As Double) As Double
	Dim svc As Object
	Dim arg AS Variant
	
    svc = createUnoService("com.sun.star.sheet.FunctionAccess")
    arg = Array(X, Y)

    MAX = svc.callFunction("MAX", arg)
End Function

REM Return the cells that make up the named range
Function NamedRange(RangeName As String)
	NamedRange = ThisComponent.NamedRanges.getByName(RangeName).getReferredCells()
End Function

REM Return the asset class allocations for the goal with the given priority
Function AssetClassAllocations(GoalPriority As Integer)
	Dim data As String
	Dim strings As Object
	Dim values() As Variant
	Dim v(2) As Variant
	Dim i As Integer
	
	data = VLOOKUP(GoalPriority, NamedRange("goal_data"), 5, 0)
	
	strings = Split(data, "|")
	Redim values(UBound(strings)) As Variant
	For i = LBound(strings) to UBound(strings)
		v = Split(strings(i), ":")
		v(1) = CDbl(v(1))
		values(i) = v
	Next i
	
	AssetClassAllocations = values
End Function

REM Return the envisioned target amount for the goal with the given priority
Function GoalAmount(GoalPriority As Integer) As Double
	GoalAmount = VLOOKUP(GoalPriority, NamedRange("goal_data"), 3, 0)
End Function

REM Determine the allocation limit for the goal with the given priority,
REM as a percentage of the net worth
Function AllocationLimitPercent(GoalPriority As Integer) As Double
	Dim limit As Double
	limit = VLOOKUP(GoalPriority, NamedRange("goal_data"), 6, 0)
	If limit = 0 Then
		limit = 1
	End If
	AllocationLimitPercent = limit
End Function

REM Return an array containing the balances of all asset classes at the given date
Function AssetClassBalances(TimeStamp As Double) As Variant
	Dim r As Integer
	Dim c As Integer
	Dim rows As Variant
	
	rows = NamedRange("balance_data").DataArray
	
	Dim balances(UBound(rows(LBound(rows))) - 1) As Currency
	
	For r = LBound(rows) To UBound(rows)
		If rows(r)(LBound(rows(r))) = TimeStamp Then
			For c = LBound(rows(r))+1 To UBound(rows(r))
				balances(c-1) = rows(r)(c)
			Next c
			
			Exit For
		End If
	Next r
	
	AssetClassBalances = balances
End Function

REM Lookup the balance of a given asset class in an array
Function LookupAssetClassBalance(BalancesArray As Variant, AssetClassCode As String) As Currency
	Dim index As Integer

	index = MATCH(AssetClassCode, NamedRange("asset_codes"), 0) - 1
	LookupAssetClassBalance = BalancesArray(index)
End Function

REM Update the balance of a given asset class in an array by deducting the allocated amount
Sub UpdateAssetClassBalance(BalancesArray As Variant, AssetClassCode As String, AllocatedAmount As Currency)
	Dim index As Integer
		
	index = MATCH(AssetClassCode, NamedRange("asset_codes"), 0) - 1
	BalancesArray(index) = BalancesArray(index) - AllocatedAmount
End Sub

REM Calculate the sum of all asset class balances
Function NetWorth(BalancesArray As Variant) As Currency
	Dim sum As Currency
	Dim amount As Currency
	
	sum = 0
	
	For Each amount In BalancesArray
		sum = sum + amount
	Next amount
	
	NetWorth = sum
End Function

REM Determine the progress made towards the goal with the given priority at the given date
Function GoalProgress(GoalPriority As Integer, TimeStamp as Double) As Double
	Dim assetClasses as Variant
	Dim balances As Variant
	Dim targetAmount As Currency
	Dim allocatedAmount As Currency
	Dim acBalance As Currency
	Dim acComponent As Currency
	Dim ac As Variant
	Dim p As Integer
	Dim limit As Currency
	Dim nw As Currency 
	Dim acAmountToAlloc As Currency
	
	balances = AssetClassBalances(TimeStamp)
	nw = NetWorth(balances)
	
	For p = 1 To GoalPriority 
		allocatedAmount = 0
		targetAmount = GoalAmount(p)
		limit = AllocationLimitPercent(p) * nw
		assetClasses = AssetClassAllocations(p)
	
		For Each ac In assetClasses
			acBalance = LookupAssetClassBalance(balances, ac(0))
			acComponent = targetAmount * ac(1)
			acAmountToAlloc = MAX(0, MIN(acComponent, acBalance))
					
			If limit > allocatedAmount Then
				If acAmountToAlloc > limit - allocatedAmount Then
					acAmountToAlloc = limit - allocatedAmount
				End If
				 
				allocatedAmount = allocatedAmount + acAmountToAlloc
				UpdateAssetClassBalance(balances, ac(0), acAmountToAlloc)
			End If
		Next ac
	Next p
	
	GoalProgress = allocatedAmount / targetAmount
End Function

Sub Test_GoalProgress
	Dim p2 As Double
	Dim p3 As Double
	
	p2 = GoalProgress(2, CDbl(DateValue("04.04.2018")))
	p3 = GoalProgress(3, CDbl(DateValue("04.04.2018")))	
End Sub