Declare Function startoptimization Lib "C:\Users\Johannes\Desktop\TestPrograms\LM_DLL\TestDll\Debug\TestDll.dll" (ByVal funcpointer As Long, ByVal Mode As Integer) As Double
Declare Function setArraySize Lib "C:\Users\Johannes\Desktop\TestPrograms\LM_DLL\TestDll\Debug\TestDll.dll" (ByVal m As Integer) As Double
Declare Function setPointerToFunction Lib "C:\Users\Johannes\Desktop\TestPrograms\LM_DLL\TestDll\Debug\TestDll.dll" (ByVal funcpointer As Long) As Double

'This function is used to move arrays between VBA and the C++ dll
Declare Sub RtlMoveMemory Lib "kernel32" ( _
hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)

'Integer counting the function calls
Public FunctionCalls As Integer


'This is the testfunction which is called by the c++ dll and wraps arround the actual function which is evaluated
'The testfunction also moves the arrays between VBA and the dll
Function TestFunc(ByRef arr As Double, ByVal m As Long) As Long
    Dim f() As Double
    Dim x() As Double
    ReDim x(1 To m)
    ReDim f(1 To m)
   
    Call RtlMoveMemory( _
        x(1), _
        arr, _
        m * Len(x(1)))
   
    Call Func(x, f)
   
    Call RtlMoveMemory( _
        arr, _
        f(1), _
        m * Len(arr))
End Function

'This is the function which is evaluated. In this example the function dimension and the cells are fixed.
Function Func(x() As Double, f() As Double) As Boolean
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    If (x(1) <> Range("B2").Value) Then Range("B2").Value = x(1)
    If (x(2) <> Range("B3").Value) Then Range("B3").Value = x(2)
    If (x(3) <> Range("B4").Value) Then Range("B4").Value = x(3)
    If (x(4) <> Range("B5").Value) Then Range("B5").Value = x(4)
    Application.Calculation = xlCalculationAutomatic
    f(1) = Range("A2").Value
    f(2) = Range("A3").Value
    f(3) = Range("A4").Value
    f(4) = Range("A5").Value
   
    FunctionCalls = FunctionCalls + 1
   
    Application.ScreenUpdating = True
   
    Func = True
End Function

'Function to set the start values
Function StartX(ByRef arr As Double, ByVal m As Long) As Long
    Dim x() As Double
    ReDim x(1 To m)
    x(1) = Range("B2").Value
    x(2) = Range("B3").Value
    x(3) = Range("B4").Value
    x(4) = Range("B5").Value
   
    Call RtlMoveMemory( _
        arr, _
        x(1), _
        m * Len(arr))
End Function

'Sub for testing the optimization
Sub TestOptimization()
    Dim a As Variant
    Dim Mode As Long
    FunctionCalls = 0
    StartTime = Timer()
   
    Mode = Range("I5").Value
    'setting the dimension of the problem for the dll. Fixed at the moment.
    a = setArraySize(4)
    'setting the hook for the function which wraps arround the actual function being evaluated
    a = setPointerToFunction(AddressOf TestFunc)
    'starting the optimization
    a = startoptimization(AddressOf StartX, Mode)

    Range("E1").Value = Timer() - StartTime
    Range("E2").Value = FunctionCalls
End Sub

#include<math.h>
#include "stdafx.h"
#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include "optimization.h"
#include <malloc.h>
#include "testDll.h"

typedef long (__stdcall * l_pF_al)(double*, long);

using namespace alglib;

//Function which can be called by the LM-Optimizer and wraps arround the callback function for VBA
void  _stdcall function1_fvec(const real_1d_array &x, real_1d_array &fi, void *ptr)
{
   double arr[4];
   int i;
   for( i = 0; i < sizeArray; i++){
      arr[i]=x[i];
   }

   pntrFunction(arr,sizeArray);
   
   for( i = 0; i < sizeArray; i++){
      fi[i]=arr[i];
   }
}

//Function which creates Jacobian by calling of function1_fvec
void function1_jac(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr)
{
   real_1d_array xnew = "[0,0,0,0]";
   real_1d_array fnew = "[0,0,0,0]";
   int i;
   int j;
   for( i = 0; i < sizeArray; i++) {
      xnew[i] = x[i];
      fnew[i] = fi[i];
   }
   
   if(iteration==0){
      function1_fvec(x,fi,ptr);
      iteration = 0;
   }
   
   for( j = 0; j < sizeArray; j++){
      xnew[j] = x[j] +0.00001;
      function1_fvec(xnew,fnew,ptr);
      for( i = 0; i < sizeArray; i++) {
         jac [i][j] = (fnew[i]-fi[i])/0.00001;
      }
      xnew[j] = x[j];
   }
}


//Setting the Global Variable for the array size.
//Global Variables are used in order to keep the argument structure for function called by the optimizer
double _stdcall setArraySize(int m)
{
   sizeArray = m;
   return 0;
}

//Setting the pntr which hooks up the VBA function, which is evaluated
//Global Variables are used in order to keep the argument structure for function called by the optimizer
double _stdcall setPointerToFunction(l_pF_al pntr)
{
   pntrFunction = pntr;
   return 0;
}

//Setting the starting values for the optimization
double _stdcall setStartX(l_pF_al startX,int sizeArray, real_1d_array &x)
{
   double arr[4];
   int i;

   startX(arr,sizeArray);
   
   for( i = 0; i < sizeArray; i++){
      x[i]=arr[i];
   }
   
   return 0;
}

//Main function which controls the optimization by LM
double _stdcall startoptimization(l_pF_al startx, int mode)
{
    real_1d_array x = "[0,0,0,0]";
   real_1d_array s = "[1,1,1,1]";
   double func = 0;
   double epsg = 0.001;
    double epsf = 0;
    double epsx = 0;

   iteration = 0;
    ae_int_t maxits = 0;
    minlmstate state;
    minlmreport rep;

   //Setting Start-Values
   setStartX(startx,sizeArray, x);

   
   if (mode == 0){
    minlmcreatev(sizeArray, x, 0.001, state);
   minlmsetacctype(state,1);
    minlmsetcond(state, epsg, epsf, epsx, maxits);

   alglib::minlmoptimize(state, function1_fvec);
   }
   if (mode == 1) {
   minlmcreatevj(sizeArray, x, state);
   minlmsetacctype(state,1);
    minlmsetcond(state, epsg, epsf, epsx, maxits);
   //minlmsetscale(state, s);
   alglib::minlmoptimize(state, function1_fvec, function1_jac);
   }


    minlmresults(state, x, rep);
   return sizeArray;

}