Solved

Excel 97 VBA:  array(arghh_list)

Posted on 2001-07-01
9
2,545 Views
Last Modified: 2007-11-27
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



0
Comment
Question by:cri
  • 5
  • 4
9 Comments
 
LVL 16

Expert Comment

by:sebastienm
ID: 6243823
cri,
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.

Regards,
Sebastien
0
 
LVL 16

Accepted Solution

by:
sebastienm earned 200 total points
ID: 6243899
Cri,
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
   worksheetFunction.Transpose(Arg)  
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.

Regards,
Sebastien
0
 
LVL 13

Author Comment

by:cri
ID: 6244407
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
http://www.stfx.ca/people/bliengme/ExcelTips/Polynomial.htm

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.

Therefore:

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.

OR

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
0
 
LVL 13

Author Comment

by:cri
ID: 6244791
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
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 16

Expert Comment

by:sebastienm
ID: 6247156
The function below returns an array from all the ranges, computations, values,... entered in the parameter list.
Eg.
Cell values:
A1: 34
A2: 45
A3: 56
B1: 1212
B5: 4554
B6: 558

In D1:I1 I enter the array fromula:
=myarglist(TRUE,A1:A3,B1/2,B5:B6)
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?

Thanks,
Sebastien
------------------------------------------------
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
           Next
           
       '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)
   Next
   
   If HorizArray Then         'Return Horizontal array
      myArgList = arglist()
   Else                       'Return Vertical Array
      myArgList = Application.WorksheetFunction.Transpose(arglist)
   End If
   
End Function
0
 
LVL 13

Author Comment

by:cri
ID: 6248034
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)
    Else
      GoTo myErrorHandler
    End If
    If allXallY(i + nPairs).Cells.Count = 1 Then
      allY(i) = allXallY(i + nPairs)
    Else
      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

myErrorHandler:
  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
0
 
LVL 13

Author Comment

by:cri
ID: 6248037
Thank you again.
0
 
LVL 16

Expert Comment

by:sebastienm
ID: 6249500
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
         U(n+1)=application.evaluate(string)
      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... :-)

Thanks,
Sebastien
0
 
LVL 13

Author Comment

by:cri
ID: 6251580
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.

0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

Article by: dandraka
There are several quick shortcuts that can make your life easier in Microsoft Programs.  These simple tips and tricks will your work more productive and you faster at completing your tasks! MS Word (1) Creating Re-usable Scraps You can create s…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now