Programming WLS function excel vba - vba

I am attempting to replicate a function for WLS (Weighted Least Squares) that I have found in a textbook in excel. There is a value error coming up and I think that I am doing something wrong in using the function.
The following is the VBA code for a supporting function Diag(w) and the function itself WLSregress():
Function Diag(W) As Variant
Dim n, i, j, k As Integer
Dim temp As Variant
n = W.Count
ReDim temp(n, n)
For i = 1 To n
For j = 1 To n
If j = i Then temp(i, j) = W(i) Else temp(i, j) = 0
Next j
Next i
Diag = temp
End Function
Function WLSregress(y As Variant, X As Variant, W As Variant) As Variant
Wmat = Diag(W)
n = W.Count
Dim Xtrans, Xw, XwX, XwXinv, Xwy As Variant
Dim m1, m2, m3, m4 As Variant
Dim output() As Variant
Xtrans = Application.Tranpose(X)
Xw = Application.MMult(Xtrans, Wmat)
XwX = Application.MMult(Xw, X)
XwXinv = Application.MInverse(XwX)
Xwy = Application.MMult(Xw, y)
b = Application.MMult(XwXinv, Xwy)
k = Application.Count(b)
ReDim output(k) As Variant
For bcnt = 1 To k
output(bcnt) = b(bcnt, 1)
Next bcnt
WLSregress = Application.Transpose(output)
End Function
This function should return the WLS estimator for the explanatory variables of equation being estimated. I understand the code leading up to the k = Application.Count(b) line but not too sure how the output bit is working.
If anyone could help me figure out why this isn't working I would be very grateful.
The following is an example image of the function trying to work.

By default, Excel will start sizing its arrays with 0 if you don't indicate otherwise. For example,
Redim arr(2,2)
will actually give you a 3 x 3 array
0 1 2
0 blank | blank | blank
1 blank | blank | blank
2 blank | blank | blank
Because of this, when you have ReDim temp(n, n), you're actually creating an array with one more row and column than you actually want. In your example, you would expect the Dialog for A3:18 to be a 16 x 16 dialog, but it will actually create a 17 x 17 dialog, throwing off your matrix multiplications (i.e. Application.MMult)
Replace this line
ReDim temp(n, n)
With this line
ReDim temp(1 to n, 1 to n)
And you should now get results returned. Up to you to determine whether the result is accurate or not.

Related

How to rename a variable (Loops to fill multiple matrices)

Im trying to fill multiple matrices according to inputs from a userform.
Right now i have to create 5 matrices but i want this to be able to change in the future, so i want to create the variables "on the fly" in my loop. I basically want to Create Matrix1, Matrix2, Matrix3 ... Matrixn, but i can't figure how to do it. Any Ideas ?
Following you can see the script --> The two last lines are totally wrong (i know it) but i just added them in hope that you understand what i want to do :)
PS: And most important i should be able to then look to Matrix1(i,j),..., Matrixn(i,j) values easily
Looking Forward your help <3
'FicheCalcul ----------------------------------------------------------------------------------------------------
Dim Temp4 As String
Dim Temp5 As String
Dim MatrixTemp(3 - 1, 5 - 1) As Double 'm-1,x-1
For i = 1 To 5 'n
For j = 0 To 3 - 1 'm-1
For k = 0 To 5 - 1 'X-1
Temp4 = j & "C" & i
Temp5 = Temp4 & k
If UserForm1.Controls(Temp5) = False Then
MatrixTemp(j, k) = ""
Else
If UserForm1.Controls(Temp5) = True Then
MatrixTemp(j, k) = k - 2 ' -2 -1 0 1 2
End If
End If
Next k
Next j
Dim ("Matrix"&i)(3-1,5-1) As Double
("Matrix"&i) = MatrixTemp
Next i
You cannot have variable variable names. Therefore you need to use arrays.
Option Explicit
Sub example()
Dim MatrixTemp(4, 5) As Double
'do your matrix stuff here
MatrixTemp(0, 0) = 1
MatrixTemp(0, 1) = 2
MatrixTemp(0, 2) = 3
Dim Matrix(4) As Variant 'create an array of 5 matices
Matrix(0) = MatrixTemp 'fill your temp matrix into the first matrix
Debug.Print Matrix(0)(0, 2) 'outputs 3
End Sub

Lee-Ready tick test using VBA

I am trying to build Lee-Ready tick test for estimating trade direction from tick data using Excel. I have a dataset containing the trade prices in descending order, and I am trying to build a VBA code that is able to loop over all the 4m+ cells in as efficient manner as possible.
The rule for estimating trade direciton goes as follows:
If Pt>Pt-1, then d=1
If Pt<Pt-1, then d=-1
If Pt=Pt-1, then d is the last value taken by d.
So to give a concrete example, I would like to transform this:
P1;P2;P3;P4
1.01;2.02;3.03;4.04
1.00;2.03;3.03;4.02
1.01;2.02;3.01;4.04
1.00;2.03;3.00;4.04
into this
d1;d2;d3;d4
1;-1;1;1
-1;1;1;-1
1;-1;1;0
0;0;0;0
Fairly straightforward nested loops suffice:
Function LeeReady(Prices As Variant) As Variant
'Given a range or 1-based, 2-dimensional variant array
'Returns an array of same size
'consisiting of an array of the same size
'of trade directions computed according to
'Lee-Ready rule
Dim i As Long, j As Long
Dim m As Long, n As Long
Dim priceData As Variant, directions As Variant
Dim current As Variant, previous As Variant
If TypeName(Prices) = "Range" Then
priceData = Prices.Value
Else
priceData = Prices
End If
m = UBound(priceData, 1)
n = UBound(priceData, 2)
ReDim directions(1 To m, 1 To n) As Long 'implicitly fills in bottom row with 0s
For i = m - 1 To 1 Step -1
For j = 1 To n
current = priceData(i, j)
previous = priceData(i + 1, j)
If current > previous Then
directions(i, j) = 1
ElseIf current < previous And previous > 0 Then
directions(i, j) = -1
Else
directions(i, j) = directions(i + 1, j)
End If
Next j
Next i
LeeReady = directions
End Function
This can be called from a sub or used directly on the worksheet:
Here I just highlighted a block of cells of the correct size to hold the output and then used the formula =LeeReady(A2:D5) (pressing Ctrl+Shift+Enter to accept it as an array formula).
On Edit: I modified the code slightly (by adding the clause And previous > 0 to the If statement in the main loop) so that it can now handle ranges in which come of the columns have more rows than other columns. The code assumes that price data is always > 0 and fills in the return array with 0s as place holders in the columns that end earlier than other columns:

Why is "Rank_Eq" breaking my loop?

I have a procedure which involves ranking values. My code (stripped down to important parts) looks like this:
Dim myArray() as variant
ReDim myArray(1 to 4, 1 to x)
for i = 1 to x
myArray(1,i) = a
myArray(2,i) = b
myArray(3,i) = c
next i
for j = 1 to x
myArray(4,j) = Application.Rank_Eq(myArray(3,j), Application.Index(myArray,3,0), 1)
next j
for k = 1 to x
myFunction(myArray(4,k))
next k
Debugging it, the for j = 1 to x loop works fine if I just return, say, the value of j or the value of myArray(3,j) but it breaks out of the loop at j=1 when I use the Application.Rank_Eq() formula.
Have I done something really stupid that I just can't see, or is this an Excel issue?
EDIT:
I tried using the following to debug:
myIndex = Application.Index(myArray,3,0)
for k = 1 to x
MsgBox myIndex(k,1)
a = Application.Rank_Eq(myIndex(1,k), editedRows, 1)
next k
This appears to run ok - i.e. each value of myIndex(k,1) is returned. However, if I add MsgBox a before next k, then it breaks. This suggests it's something to do with the value being returned by Rank_Eq, no?
Not sure it's part of the issue - but I had to access the Rank_Eq method through the WorksheetFunction object, not the Application object.
Secondly, you'll notice that this function needs a Double and a Range for the first 2 arguments. Currently you are supplying a Variant and whatever the value is from your Index() method.
Try casting the Variant to a Double like so for the first argument:
CDbl(myArray(3, j))
For the second argument, I have no idea from your question how the array gets populated so I can't guess where the Range argument needs to refer to...

Converting variant into array in VBA

I am trying to use the Excel built-in function SumProduct in VBA but keep getting errors. The code snippet looks as follows
Dim X As Variant
'x is input value, given as Range
X = x.Value
Dim Y() As Double
ReDim Y(1 To N)
'filling Y with whatever values
Dim i As Long
For i = 1 To UBound(Y)
Y(i) = 2
next i
Result = WorksheetFunction.SumProduct(X,Y)
However, this code returns #Value, and I guess it's because X is Variant and Y is of type Double (so type-mismatch).
Is there a way to convert this variant into double (array)? I have tried declaring X as Double instead, and then looping through the input-range itself, but don't know how to "access" each element in the input-range.
Any suggestions?
Thanks
Y will need to be a 2D variant array. (I suggest you construct Y in the required form directly.) Try this:
Function Result()
Dim X As Variant
'rng is input value, given as Range. You can't have x and X in VBA due to case-insensitivity
X = rng.Value
N = UBound(X, 1) - LBound(X, 1) + 1 'Should really declare N before using it
Dim Y As Variant 'Changed type here
ReDim Y(1 To N, 1 To 1) 'We need a 2D variant
'filling Y with whatever values
Dim i As Long
For i = 1 To UBound(Y)
Y(i, 1) = 2
Next i
Result = WorksheetFunction.SumProduct(X, Y)
End Function

Powers of Matrices

How do I write a VBA Macro that would take the power of a matrix (to an arbitrary user-specified power) that is located in cells A1 to C3?
Taking your question literally in the mathematical sense, this macro raises the matrix to a power (4 in the example) by repeatedly calling Excel's MMULT function.
Dim i As Long
Dim pow As Long
Dim vIn As Variant
Dim vOut As Variant
pow = 4 ' or whatever
' Fetch matrix from sheet
vIn = Range("A1:C3")
' Raise to power
vOut = vIn
For i = 1 To pow - 1
vOut = WorksheetFunction.MMult(vOut, vIn)
Next i
' Write result to sheet
Range("E1:G3") = vOut
I used the function below. Please note that, when the exponent is 0, the function returns the identity matrix, otherwise the matrix multiplied by itself the exponent number of times.
'Raises matrix to a power
Function PowerMatrixNew(rngInp As Range, lngPow As Integer) As Variant()
'create identitu for power 0
Dim identity() As Variant
ReDim identity(rngInp.Rows.Count, rngInp.Rows.Count)
Dim i As Integer
Dim j As Integer
For i = 1 To rngInp.Rows.Count
For j = 1 To rngInp.Rows.Count
If (i = j) Then
identity(i, j) = 1
Else
identity(i, j) = 0
End If
Next j
Next i
PowerMatrixNew = identity
For i = 1 To lngPow
PowerMatrixNew = Application.WorksheetFunction.MMult(rngInp, PowerMatrixNew)
Next
End Function
There was a question like this some years ago which I remember because it was called matrix arithmetic but not as I was taught at school.
Fill cells A1:C3 with the numbers 1 to 9. Set cell A5 to 2. Select cells A7:C9 and type
=power(A1:C3,A5) ctrl+shift+enter
and cells A7:C9 will be set to the squares of the values in A1:C3. Change A5 to 3 and cells A7:C9 will be set to the cubes of the values in A1:C3.
The equivalent in VBA is:
Range("a7:c9").FormulaArray = "=Power(a1:c3, a5)"