**DispCallFunc, which can successfully be used to provide function pointer mechanism in VBA**. With this API function (and a couple of additional tricks), we can actually create extremely flexible, extendable and light program designs. At this point, get your coffee ready, because the story is going to be a long one.

**SOLVER FOR NON-LINEAR FUNCTIONS**

The end result of this post will be a small, flexible and extendable design for a numerical procedure, which solves a root for a given non-linear function. Now, as you already know there are more than a lot of these root-finding algorithms available. In this post, we just use simple Bisection method. We will create a program design, which can be used to solve for option implied volatility or bond yield-to-maturity, for example.

**WIN API DISPCALLFUNC FUNCTION**

Let us start and go through Windows API function DispCallFunc, which enables us to implement our desired "function-pointer" mechanism. DispCallFunc belongs to a family of Automation objects (OleAut32.dll) which are written in C language. So, we need to be able to handle parameter exchanges between VBA and C interface. There are a lot of articles about this issue to be found in web. One particularly helpful and otherwise extremely comprehensive source for truly advanced VB stuff is a book written by Bruce McKinney called Hardcore Visual Basic. From the previous link, you have an access to online version of this awesome book. The issues concerning VBA/C interfacing are dealt within the chapter 2 (The Second Level of Basic Enlightenment).

Now, to be able to understand how to use DispCallFunc function in practice, let us first quickly go through its arguments. After this we create two simple example programs on the fly.

HRESULT DispCallFunc( void *pvInstance, ULONG_PTR oVft, CALLCONV cc, VARTYPE vtReturn, UINT cActuals, VARTYPE *prgvt, VARIANTARG **prgpvarg, VARIANT *pvargResult );

**void *pvInstance**is a special type of pointer that can be pointed at objects of any data type. However, since we are not dealing with any actual COM objects we can set this value to be 0.

**ULONG_PTR oVft**is a pointer to unsigned long variable. With this argument we will pass the address of a function. DispCallFunc must have a pointer to the callback function's address in memory. VBA supports the AddressOf operator, which makes it possible to pass the address of a VBA function to a DLL function.

**CALLCONV cc**is an argument for Calling convention to be used. In general, when we deal with C/C++ DLL functions in VBA, we have to use stdcall convention (4).

**VARTYPE vtReturn**defines a type for function return value. We will use VbVarType enumerated type that indicates the type of the function's return value. If the function does not return any value (Sub procedure in VBA), we will simply use VbVarType.vbEmpty.

**UINT cActuals**is an unsigned integer for setting the number of function arguments.

**VARTYPE *prgvt**is a pointer to an array of Integer type VbVarType enumerated values. DispCallFunc must have information on the type of the function arguments. How do we deal with this one in practice? First, we wrap all function argument variable types into an array one by one by using VarType function. Then, we just pass the address of the first item of array for DLL function. When dealing with arrays from VBA to C/C++ DLL functions, we always pass the first array item, not the whole array. If there is not any function arguments, we can simply use zero value.

**VARIANTARG **prgpvarg**is a pointer to an array of pointers. First, we need to convert all function arguments into new Variant data types. Then, we wrap the address of each variable into a Long data type array (address is Long data type) by using VarPtr function. Finally, we just pass the address of the first item of array. Again, if there is not any function arguments, we can simply use zero value.

**VARIANT *pvargResult**is a pointer to variant data type. We need to create a variant type variable and give its address by using VarPtr function again. The result value of a function what DispCallFunc is using, is then stored into this variable. The return value of the actual DispCallFunc is zero (assuming that a function call has been successful).

**DispCallFunc - example 1.**

First, we create a simple program using DispCallFunc. In this example, function to be called by DispCallFunc does not have any arguments or any return value. DispCallFunc will just call procedure someFunction, which then pops up a message. CopyPaste the following program into a new VBA standard module and run the program.

Option Explicit ' Private Declare Function DispCallFunc Lib "OleAut32.dll" ( _ ByVal pvInstance As Long, _ ByVal oVft As Long, _ ByVal cc As Long, _ ByVal vtReturn As Integer, _ ByVal cActuals As Long, _ ByVal prgvt As Long, _ ByVal prgpvarg As Long, _ ByVal pvargResult As Long _ ) As Long ' Public Sub someFunction() MsgBox "DispCallFunc just called me!" End Sub ' Public Sub tester() ' Dim DispCallFuncResult As Long Dim result As Variant: result = vbEmpty DispCallFuncResult = DispCallFunc( _ 0, _ AddressOf someFunction, _ CLng(4), _ VbVarType.vbEmpty, _ 0, _ 0, _ 0, _ VarPtr(result)) End Sub '

**DispCallFunc - example 2.**

Next, our function, which is going to get called by DispCallFunc, has two arguments (double) and a return value (double). CopyPaste the following program into a new VBA standard module and run the program.

Option Explicit ' Private Declare Function DispCallFunc Lib "OleAut32.dll" ( _ ByVal pvInstance As Long, _ ByVal oVft As Long, _ ByVal cc As Long, _ ByVal vtReturn As Integer, _ ByVal cActuals As Long, _ ByVal prgvt As Long, _ ByVal prgpvarg As Long, _ ByVal pvargResult As Long _ ) As Long ' Public Function someFunction(ByVal x As Double, ByVal y As Double) As Double someFunction = x * y End Function ' Public Sub tester() ' Dim DispCallFuncResult As Long Dim result As Variant: result = vbEmpty ' Dim x As Double: x = 1.234 Dim y As Double: y = 9.876 ' Dim vx As Variant: vx = CVar(x) Dim vy As Variant: vy = CVar(y) ' Dim varTypes(0 To 1) As Integer varTypes(0) = VarType(vx) varTypes(1) = VarType(vy) ' Dim varPointers(0 To 1) As Long varPointers(0) = VarPtr(vx) varPointers(1) = VarPtr(vy) ' DispCallFuncResult = DispCallFunc( _ 0, _ AddressOf someFunction, _ CLng(4), _ VbVarType.vbDouble, _ 2, _ VarPtr(varTypes(0)), _ VarPtr(varPointers(0)), _ VarPtr(result)) ' Debug.Print result End Sub '

DispCallFunc works as expected and it is enabling "function pointer mechanism" to be used. We should now be ready for implementing DispCallFunc function in our root solver design.

**SOLVER DESIGN WITH DISPCALLFUNC**

A couple of words about some of the design targets. We would like to be able to

- change our numerical algorithm for root-solving procedure at will.
- change target function (a function which root is going to be solved) used by root solver at will.

**To change our numerical algorithm for root-solving procedure at will**gives a strong indication for using VB interfaces. In this case, we will create a common IRootSolver interface, from which we can create any desired new root-solving algorithm implementation.

IRootSolver interface has only one public function (solve), which returns a double and takes in two arguments: "algorithm-related" parameters and "function-related" parameters. In a nutshell, we make a clear division for parameters which are "algorithm-related" and parameters which are "function-related".

When we create our IRootSolver interface and its function signature for this public solve method, we have to make a decision about what are the input arguments for this public solve method. After this, we are married with this function signature, come rain or come shine. Each and every new interface implementation must implement exactly the same interface function signature for this public solve method.

However, each new IRootSolver interface implementation can naturally have different amount of algorithm-related parameters. The most flexible way to have variable amount of input arguments, is to wrap all input parameters into a dictionary data structure. Similarly, target function related parameters are wrapped into a separate data structure. With this approach, public solve method now demands two separate dictionary data structures as its input arguments. One for "algorithm-related" parameters and another for "function-related" parameters. After this, the actual root solver implementation will then "unzip" both data structures to get all the parameters what it needs to perform its numerical procedures. I have been opening this "parameter wrapper" approach in one of my previous posting.

But why this kind of solution for feeding parameters? In some other languages you have constructors for all class member variables and those constructors does not need to have any homogenous signatures for arguments. With VBA we do not even have constructors (class initializers are not really constructors, since you can not have any access to class member variables from outside class itself). So, there is a lot of problems coming from the fact, that VBA does not have real constructors. I have been chewing this issue before in this posting under "constructor problem". Anyway, we can find a way out of this irritating problem just by wrapping all possible parameters inside a data structure and then define our public interface function so, that it is taking only data structure as an input argument.

**To change target function used in root solver at will**is now easy. First of all, the actual public functions are stored separately in a standard VBA module. A target function is one of those "algorithm-related" parameters and we will wrap its address into a Dictionary by using AddressOf function. As soon as any solver implementation will "unzip" the input algorithm-related data structure, it will have an address to our given target function what solver can use in DispCallFunc function. Function address is really all it knows. Now, we can give any function from our "function library" and solver implementation will then be using this given function with DispCallFunc function, assuming of course that we give all the other required parameters for it.

**SOLVER DESIGN IMPLEMENTATION**

Finally, we will now create a program, which solves zero-coupon bond yield-to-maturity and option implied volatility as an example. For solving a zero-coupon bond yield-to-maturity, there is no need for any numerical procedure since analytical formula exists. However, it is included here only for demonstration purposes.

Open a new Excel for this project and copyPaste all the following program parts and follow all the given instructions. At this point you could reference Microsoft Scripting Runtime library in your VB editor (Tools - References - Microsoft Scripting Runtime), since we are using Dictionary data structure in our program.

**Function library**(New standard VBA module, name=FuncLib)

Option Explicit ' ' zero-coupon bond price Public Function ZCB_price( _ ByVal n As Double, _ ByVal y As Double, _ ByVal t As Double _ ) As Double ' ZCB_price = n * Exp(-y * t) End Function ' ' plain vanilla call option pricing formula Public Function BS_call( _ ByVal s As Double, _ ByVal x As Double, _ ByVal v As Double, _ ByVal t As Double, _ ByVal r As Double _ ) As Double ' Dim d1 As Double: d1 = (Log(s / x) + (r + 0.5 * v * v) * t) * (1 / (v * Sqr(t))) Dim d2 As Double: d2 = d1 - v * Sqr(t) BS_call = s * CND(d1) - x * Exp(-r * t) * CND(d2) End Function ' ' cumulative normal distribution (Abramowitz and Stegun approximation 1964) Public Function CND(ByVal z As Double) As Double ' Dim b1 As Double, b2 As Double, b3 As Double, b4 As Double, b5 As Double, p As Double, _ c2 As Double, a As Double, b As Double, t As Double, n As Double ' If (z > 6#) Then CND = 1: Exit Function If (z < -6#) Then CND = 0#: Exit Function ' b1 = 0.31938153: b2 = -0.356563782 b3 = 1.781477937: b4 = -1.821255978 b5 = 1.330274429: p = 0.2316419 c2 = 0.3989423: a = Abs(z) t = 1# / (1# + a * p) b = c2 * Exp((-z) * (z / 2#)) n = ((((b5 * t + b4) * t + b3) * t + b2) * t + b1) * t n = 1# - b * n If (z < 0#) Then n = 1# - n CND = n End Function '

**IRootSolver interface**(New VBA class module, name=IRootSolver)

Option Explicit ' Public Function solve( _ ByRef algorithmParameters As Scripting.Dictionary, _ ByRef targetFunctionParameters As Scripting.Dictionary _ ) As Double ' ' interface - no implementation End Function '

**IRootSolver implementation**(New VBA class module, name=BisectionAlgorithm)

Option Explicit ' Implements IRootSolver ' ' Win API function declaration for DispCallFunc ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms221473(v=vs.85).aspx Private Declare Function DispCallFunc Lib "OleAut32.dll" _ (ByVal pvInstance As Long, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As Long, _ ByVal cActuals As Long, ByVal prgvt As Long, ByVal prgpvarg As Long, ByVal pvargResult As Long) As Long ' Private Function IRootSolver_solve( _ ByRef algorithmParameters As Scripting.Dictionary, _ ByRef targetFunctionParameters As Scripting.Dictionary _ ) As Double ' ' extract all algorithm-related parameters for this particular implementation Dim f As Long f = algorithmParameters(E_TARGET_FUNCTION_ADDRESS) ' Dim targetValue As Double targetValue = algorithmParameters(E_TARGET_FUNCTION_TARGET_VALUE) ' Dim targetParameterNumber As Integer targetParameterNumber = (algorithmParameters(E_TARGET_FUNCTION_TARGET_PARAMETER_NUMBER) - 1) ' Dim iterations As Long iterations = algorithmParameters(E_MAX_ITERATIONS) ' Dim tolerance As Double tolerance = algorithmParameters(E_TOLERANCE) ' Dim low As Double: low = algorithmParameters(E_LOW) Dim high As Double: high = algorithmParameters(E_HIGH) ' ' create data/data structures for Win API Dim IDispCallFuncResult As Long Dim result As Variant: result = vbEmpty Dim varTypes() As Integer: ReDim varTypes(0 To targetFunctionParameters.Count - 1) Dim varPointers() As Long: ReDim varPointers(0 To targetFunctionParameters.Count - 1) ' ' iterate to solve for root Dim root As Double: root = (high + low) * 0.5 Dim counter As Long For counter = 1 To iterations ' ' set parameters for Win API ' extract function-related parameters Dim i As Integer For i = 0 To targetFunctionParameters.Count - 1 ' ' use root estimate for targetParameterNumber If (i = targetParameterNumber) Then varTypes(i) = VarType(CVar(root)) varPointers(i) = VarPtr(CVar(root)) Else varTypes(i) = VarType(CVar(targetFunctionParameters.Items(i))) varPointers(i) = VarPtr(CVar(targetFunctionParameters.Items(i))) End If Next i ' ' use DispCallFunc as "function pointer" IDispCallFuncResult = DispCallFunc( _ 0, _ f, _ CLng(4), _ VbVarType.vbDouble, _ targetFunctionParameters.Count, _ VarPtr(varTypes(0)), _ VarPtr(varPointers(0)), _ VarPtr(result) _ ) ' ' use result from DispCallFunc to adjust root estimate Dim difference As Double: difference = (result - targetValue) If (Abs(difference) <= tolerance) Then Exit For ' If (difference < 0) Then high = high low = root Else high = root low = low End If ' root = (high + low) * 0.5 Next counter ' ' return root estimate IRootSolver_solve = root End Function '

**Enumerators for parameter wrappers**(New standard VBA module, name=Enumerators)

Option Explicit ' Public Enum ENUM_PARAMETERS ' E_TARGET_FUNCTION_ADDRESS = 1 E_TARGET_FUNCTION_TARGET_VALUE = 2 E_TARGET_FUNCTION_TARGET_PARAMETER_NUMBER = 3 E_MAX_ITERATIONS = 4 E_TOLERANCE = 5 E_LOW = 6 E_HIGH = 7 ' E_SPOT = 8 E_STRIKE = 9 E_TIME = 10 E_RATE = 11 E_IMPLIED_VOLATILITY = 12 E_FACE_VALUE = 13 E_YIELD = 14 End Enum '

**Main program**(New standard VBA module, name=MainProgram)

Option Explicit ' Public Sub tester() ' ' create rootSolver and wrappers for parameters Dim rSolver As IRootSolver: Set rSolver = New BisectionAlgorithm Dim algorithmParameters As Scripting.Dictionary Dim targetFunctionParameters As Scripting.Dictionary ' ' ' A. SOLVE FOR ZERO-COUPON BOND YIELD ' wrap all algorithm-related parameters Set algorithmParameters = New Scripting.Dictionary algorithmParameters.Add E_TARGET_FUNCTION_ADDRESS, AddressOf FuncLib.ZCB_price algorithmParameters.Add E_TARGET_FUNCTION_TARGET_VALUE, CDbl(94.01252) ' corresponds to E_YIELD algorithmParameters.Add E_TARGET_FUNCTION_TARGET_PARAMETER_NUMBER, CInt(2) algorithmParameters.Add E_MAX_ITERATIONS, CLng(1000) algorithmParameters.Add E_TOLERANCE, CDbl(0.00001) algorithmParameters.Add E_LOW, CDbl(1) algorithmParameters.Add E_HIGH, CDbl(0) ' ' wrap all target-function-related parameters Set targetFunctionParameters = New Scripting.Dictionary targetFunctionParameters.Add E_FACE_VALUE, CDbl(100) ' parameter is given as empty value targetFunctionParameters.Add E_YIELD, CDbl(0) targetFunctionParameters.Add E_TIME, CDbl(2.487) ' Dim bondYield As Double bondYield = rSolver.solve(algorithmParameters, targetFunctionParameters) ' Debug.Print bondYield Set algorithmParameters = Nothing Set targetFunctionParameters = Nothing ' ' ' B. SOLVE FOR IMPLIED VOLATILITY ' wrap all algorithm-related parameters Set algorithmParameters = New Scripting.Dictionary algorithmParameters.Add E_TARGET_FUNCTION_ADDRESS, AddressOf FuncLib.BS_call algorithmParameters.Add E_TARGET_FUNCTION_TARGET_VALUE, CDbl(10.985) ' corresponds to E_IMPLIED_VOLATILITY algorithmParameters.Add E_TARGET_FUNCTION_TARGET_PARAMETER_NUMBER, CInt(3) algorithmParameters.Add E_MAX_ITERATIONS, CLng(1000) algorithmParameters.Add E_TOLERANCE, CDbl(0.00001) algorithmParameters.Add E_LOW, CDbl(0) algorithmParameters.Add E_HIGH, CDbl(1) ' ' wrap all target-function-related parameters Set targetFunctionParameters = New Scripting.Dictionary targetFunctionParameters.Add E_SPOT, CDbl(101.25) targetFunctionParameters.Add E_STRIKE, CDbl(100) ' parameter is given as empty value targetFunctionParameters.Add E_IMPLIED_VOLATILITY, CDbl(0) targetFunctionParameters.Add E_TIME, CDbl(1.25) targetFunctionParameters.Add E_RATE, CDbl(0.0215) ' Dim impliedVolatility As Double impliedVolatility = rSolver.solve(algorithmParameters, targetFunctionParameters) ' Debug.Print impliedVolatility Set algorithmParameters = Nothing Set targetFunctionParameters = Nothing Set rSolver = Nothing End Sub '

Note, that the

__order of parameters inside data structure__(target function-related parameters)

__must correspond exactly the order of target function arguments found in the actual function signature__(found in our function library module). Also, the variable what we are about to solve (implied volatility, yield) is also given in function-related parameter wrapper but with zero value. Then, in algorithm-related parameter wrapper we have information, what is the order of item in function-related wrapper, which is going to be solved.

**PROS, CONS AND AFTERTHOUGHTS**

DispCallFunc works as desired and it can enable cool callback mechanism to be used in VBA. With this design we can implement any new numerical algorithm from our generic IRootSolver. No matter what are the input arguments or how many input arguments there will be for any new solver implementation. We can always zip these input parameters inside a wrapper. In this way, we obey the requirement for "homogeneous public interface function signature" for any new IRootSolver interface implementation. Moreover, we can use any auxiliary function to be solved, since we are delivering the address of this auxiliary function to solver as one of its input parameters.

Of course we need to admit, that compared with the corresponding C/C# mechanism, there are "some additional twists" included, but nothing really too complicated or unmanageable.

Well, that's all for now. If you have been missing some proper callback mechanisms for your VBA programs, you might take a look at this DispCallFunc stuff. This time I need to give my deepest appreciations for Akihito Yamashiro, who has wonderfully and thoroughly opened this issue in his blog.

It has really been a while since my last posting. I have been more than busy with so many issues going on. Being otherwise "A Hard Working Family Man" these days, I additionally decided to go through Certificate in Quantitative Finance program, what I have been quietly woodshedding on my own for the last 6 months or so. During the program I have been learning a lot of interesting stuff and hopefully I could be able to share some of those things with you as well. After finishing CQF, I should be able to allocate some time again for this blog.

Thanks for reading, see you again and have a nice weekend!

-Mike

no sure my first post was succesfully sent so here am i again.

ReplyDeleteTks Mike for sharing with us all those precious resources.

I am actually working on VBA project about asset allocation optimization under the CVaR concept with constraints. The goal is to calculate and plot the efficient frontier.

While conceptually not difficult, I am experiencing problem with the XL solver. The routine returns le local optimum which are not absolute optimum as such my frontier is tossed.

I have read you post about root-finding algorithms which seems to be perfect for my project. However I am quite bit lost in adapting your code. I use a vector of expected return, vector of weight, VarCovar Matrix. I would appreciate if you could point me in the right direction.

Tks so much for you help.

Jean-François (globetribe@gmail.com)

wicked

ReplyDelete