Excel 97 VBA: array(arghh_list)

I have asked this question in another site, but got no replies, not to speak of a solution.

How do I generate an arglist with Excel 97 / VBA ? The code below for an array formula is an example only, the wanted method #2 seems to be necessary to pass calculated and/or 'non-adjacent' x datapoints to LINEST, I am trying to automate a multiple regression _w/o_ pasting the auxiliary data to a worksheet range.

Function Arghh_list(myRange As Range, iWhich As Integer) as Variant
  Dim arrDefault As Variant, arrHowTo As Variant, arrNotThis As Variant
  Dim arglist As Variant

  Select Case iWhich
    Case 1
      'Easy, hardcoded
      arrDefault = Array(1, 4, 9, 16)
      Arghh_list = arrDefault
    Case 2
      'How to generate arglist of form 'arg1, arg2, arg3,..., argN' ?
      'arglist = ????
      arrHowTo = Array(arglist)
      Arghh_list = arrHowTo
    Case 3
      'Ordinary array, filled with the values of the passed range
      arrNotThis = myRange.Value
      Arghh_list = arrNotThis
    Case Else
      MsgBox "check syntax"
  End Select
End Function

LVL 13
Who is Participating?
sebastienmConnect With a Mentor Commented:
After re-reading this post, maybe what you look for is just:
Function Arghh_list(iWhich As Integer, ParamArray Arg() as Variant) as Variant


Case 2
   Arghh_list = Arg
This create a horizontal array.
To get a vertical one, maybe you can use the
in a Case 4?

Also, it will work with computations e.g
in A1:B1    =Agrhh_list(2,2/3,4*3)

Finally, since ParamArray, if used, has to be the last of function parameter list, I moved the iWhich to the first place.

I am not sure i really understand what you are looking for.
Where do you get Arg1, Arg2,...from? And in which form (array?)? Are they your Ys to be used in LinEst?

I think you try to build an array like {1,2,3}, don't you?

Idea 1:
   Arghh_list =
   application.evaluate( "{" & Arg1 & "," & Arg2 & "}" )

   The string in the Evaluate can be built from a loop that takes care of the number of Args.

Idea 2:
   You wrap the LinEst in another function, eg. MyLinEst
   and declare the arguments as ParamArray, then you study the ParamArray and take action based on that, calling the WorksheetFunction.Linest

I think I am far from what you want, but it might help.

criAuthor Commented:
Thank you for tackling this one.

Guess I need to provide some background.

One of the unresolved flaws of Excel is that the coefficients of Trendlines are returned as text. For some types there are tricks to get them directly (i.e. w/o determining them yourself or, gasp !, parsing the datalabel text)

I found this trick

which is rather handy for polynomials. I automated the writing of the formula and the calculation of the approximated points. No big deal. However, I would like to have the approximated points between the base points, otherwise I am forced to plot them as separate series as the _lines_ do follow the data point order, not their x value, even for a XY diagram, which is...er...Microsoft.


a) How do I pass non-adjacent ranges _addresses_ to LINEST on a worksheet formula ? It works for numeric values, but not for addresses. This would be my preferred solution as not dependent from my add-in.


b) How do I generate the necessary arrays in VBA ? The array formula  below is still for adjacent base datapoints and I can not get it to run even as this. There must be a way feed LINEST the proper array as shown in the 'override' lines.

Function csePolyCoeff(rngXval As Variant, rngYval As Variant)
  'Returns the coefficients of a polynomial regression of the order nColumnCells-1
  'The call must inserted with Ctrl+Shift+Enter in (n_Order)+1 cells of any columns
  Dim vLinEstRes As Variant, vXval As Variant, vYval As Variant
  Dim nOrder As Integer, nPoints As Integer, i As Integer, j As Integer
  'Determine order
  nOrder = Application.Caller.Rows.Count - 1
  'Fill x value array
  With rngXval
    nPoints = .Rows.Count
    ReDim vXval(nPoints, nOrder)
    For i = 1 To nPoints
      For j = 1 To nOrder
        vXval(i, j) = .Cells(i, 1).Value ^ j
      Next j
    Next i
  End With
  'Override, sighhh...
  vXval = Array(Array(1, 2, 3, 4), Array(1, 4, 9, 16), Array(1, 8, 27, 64))
  'Fill Y value array
  With rngYval
    nPoints = .Rows.Count
    ReDim vYval(nPoints)
    For i = 1 To nPoints
      vYval(i) = .Cells(i, 1).Value
    Next i
  End With
  'Override, arghhh, not even a 1 dimensional array...
  vYval = Array(7, 24, 71, 160)
  'Return the bloody coefficients
  With WorksheetFunction
    csePolyCoeff = .Transpose(.LinEst(vYval, vXval))
  End With
End Function
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

criAuthor Commented:
The ParamArray idea could work provided I can get the 'allX' to work

Function csePolynomialCoeff(ParamArray allXallY() As Variant) As Variant
  'Returns the coefficients of a polynomial regression of the order nColumnCells-1

  Dim nOrder As Integer, nPoints As Integer, i As Integer, j As Integer
  Dim allY As Variant
  Dim allX As Variant
  'Determine datapoint pairs
  nPoints = (UBound(allXallY) + 1) / 2
  'Determine order
  nOrder = Application.Caller.Rows.Count - 1
  ReDim allY(nPoints - 1)
  'This probably is wrong
  ReDim allX(nPoints - 1, nOrder)
  For i = 0 To nPoints - 1
     'This works
     allY(i) = allXallY(i + nPoints)
     For j = 1 To nOrder
       'This does not...
       allX(i, j) = allXallY(i) ^ j
       MsgBox allX(i, j)
     Next j
  Next i
  'Override it or it shall not work yet
  'allX = Array(Array(1, 2, 3, 4), Array(1, 4, 9, 16), Array(1, 8, 27, 64))
  With WorksheetFunction
    csePolynomialCoeff = .Transpose(.LinEst(allY, allX))
  End With
End Function
The function below returns an array from all the ranges, computations, values,... entered in the parameter list.
Cell values:
A1: 34
A2: 45
A3: 56
B1: 1212
B5: 4554
B6: 558

In D1:I1 I enter the array fromula:
It returns
34  45  56  606  4554  558

The first argument True/False is used to return
True: horizontal array
False: Vertical array

Would this help?
It seem to work fine in Linest,
eg. =linest(myarglist(...),...)

However, I just made the case for Range and Double in the ParamArray. It needs some more work such the cases Variant(), maybe others...

By the way, I couldn't find how to turn my answer to a previous post to a Comment, or even delete it. Any idea?

Function myArgList(HorizArray As Boolean, ParamArray p() As Variant) As Variant
'Return an horizontal array if HorizArray is True, else vertical array

   Dim arglist() As Double
   Dim maxArgIndex As Long
   Dim cell As Range
   Dim i As Integer, j As Integer
   'Test if p missing
   If UBound(p) < LBound(p) Then
      'Code returning error here
      Exit Function
   End If
   ReDim arglist(0)
   maxArgIndex = -1
   For i = LBound(p) To UBound(p)
       'Case of a Range
       If TypeName(p(i)) = "Range" Then
           ReDim Preserve arglist(0 To (maxArgIndex + p(i).Cells.Count))
           j = 1
           For Each cell In p(i).Cells
              arglist(maxArgIndex + j) = CDbl(cell.Value)
              j = j + 1
       'Case of Double
       ElseIf TypeName(p(i)) = "Double" Then
           ReDim Preserve arglist(0 To (maxArgIndex + 1))
           arglist(maxArgIndex + 1) = p(i)
       'Case of a Variant()
       ElseIf TypeName(p(i)) = "Variant()" Then
           'Code here for Variant() case
       'Then other cases
       End If
       maxArgIndex = UBound(arglist)
   If HorizArray Then         'Return Horizontal array
      myArgList = arglist()
   Else                       'Return Vertical Array
      myArgList = Application.WorksheetFunction.Transpose(arglist)
   End If
End Function
criAuthor Commented:
sebastienm, I managed to solve the 'array of arrays' problem I had in my last post. My error was to set up multi dimensional array for the X members instead of a array containing arrays.

Thank to your help (and some try and error from my part) I now have this array formula:

Function csePolynomialCoeff(ParamArray allXallY() As Variant) As Variant
  'Array formula to return the coefficients for a polynomial regression
  'Usage: See myErrorhandler
  'Room for improvement: Allow passing multicell partial ranges
  'Attention: Using Base 0 arrays because of Linest/Return to range
  Dim nOrder As Integer, nPoints As Integer, nPairs As Integer, i As Integer, j As Integer
  Dim allY As Variant, allX As Variant, allXj As Variant, allXeq As Variant
  'Determine datapoint pairs
  nPoints = UBound(allXallY) + 1
  If nPoints <> WorksheetFunction.Even(nPoints) Then GoTo myErrorHandler
  nPairs = nPoints / 2
  'Determine order
  nOrder = Application.Caller.Rows.Count - 1
  'Provide storarge space
  ReDim allY(nPairs - 1)
  ReDim allX(nPairs - 1)
  ReDim allXj(nPairs - 1)
  ReDim allXeq(nOrder - 1)
  'Check compliance with single cell rule, then fill the 0 based arrays
  For i = 0 To nPairs - 1
    If allXallY(i).Cells.Count = 1 Then
      allX(i) = allXallY(i)
      GoTo myErrorHandler
    End If
    If allXallY(i + nPairs).Cells.Count = 1 Then
      allY(i) = allXallY(i + nPairs)
      GoTo myErrorHandler
    End If
  Next i
  'Fill the 0 based subarrays for each exponent
  For j = 1 To nOrder
    For i = 0 To nPairs - 1
      allXj(i) = allX(i) ^ j
    Next i
    'Assign to the 0 based 'array of arrays'
    allXeq(j - 1) = allXj
  Next j
  'Now just do it
  With WorksheetFunction
    csePolynomialCoeff = .Transpose(.LinEst(allY, allXeq))
  End With
Exit Function 'Regular exit

  MsgBox "How to use: " & vbLf _
         & "* Datapoints: First all X, then all Y, as single cells ! Best done with Ctrl+Select." & vbLf _
         & "* Order =(Number selected cells in the column range) - 1 " & vbLf & vbLf _
         & "Remember to finish all edits with Ctrl+Shift+Enter, hence the prefix 'cse'"
End Function
criAuthor Commented:
Thank you again.
Good job, cri.

Enhancement idea for general use:

  1-a function ArgList(ParamArray) wich would
   build the horizontal array.

  2-A second function BuiltArray which build a horizontal  series array based on an expression. (eg. used to build {1,2,3,4,5} )
    BuiltArray(Length as integer, ParamArray p as Variant)
    Length: length of the array
    P(0)...p(n-1) : n first values
    p(n): string expression

    eg. BuiltArray(4,{1,"U0+1"}) --> {1,2,3,4}
      4 elements array defined as
      U(0)=1, U(n+1)=U(n) + 1
      In code:
      loop for each unknow elements
         replace Ui in string expression
      return U()

As an example, you could use it in
=Linest(ArgList(..),ArgList(..)^BuiltArray(...)) ...

But maybe it is not worth spending that much time on it.

Also, in a ParamArray P defined as variant, a component p(i) maybe itself a several-dimension array, therefore the code has to use a nested loop instead of a single loop to scan each element of p(i).
Here is a trick to determine the number of dimensions of an array:
  Array() --> 1
  Array(,) --> 2

Number of DIms of Array: from Laurent Longre
>Private Declare Sub ArrayPtr Lib "Kernel32" Alias "RtlMoveMemory" _
>   (hpvDest As Long, hpvSource() As Any, ByVal cbCopy As Long)

> Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" _
>   (hpvDest As Long, ByVal hpvSource As Long, ByVal cbCopy As Long)

> Sub Test()

>   Dim MyArray()
>   Dim Ptr As Long, cDims As Long

>   ReDim MyArray(1, 2, 3, 4, 5, 6)

>   ArrayPtr Ptr, MyArray(), 4
>   CopyMemory cDims, Ptr, 2

>   MsgBox cDims & " dimensions."

> End Sub

Ok...i stop here... :-)

criAuthor Commented:
sebastienm, thank you for the tips. I know that building a library with auxiliary procedures would compact my code, but lacking an include statement, I would take a lot of attention when pasting the code into another workbook. I like to have my code autosufficient.

As for the Sub itself, I modified it such that I can pass a Xrange and a Yrange and it will consider only these X,Y points with a non empty Y point. Linest should have this as default, damn it.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.