EXCEL VBA: Dot Product using Arrays - excel

Below is example code which is an excerpt from a larger whole. I am attempting to compute the dot product of vectors beta and Xtempj which should be a scalar and then to multiple the resulting scalar by another scalar, Ycoded(j,1).
However, I am receiving an error message "Type mismatch" during the assignment statement for temp1(j,1).
Option Explicit
Sub XX()
Dim beta As Variant
Dim temp1 As Variant
Dim X5 As Variant
Dim Xtempj As Variant
Dim Ycoded As Variant
ReDim beta(1 To 2, 1 To 1)
ReDim X5(1 To 2, 1 To 2)
ReDim temp1(1 To 2, 1 To 1)
ReDim Xtempj(1 To 2, 1 To 1)
ReDim Ycoded(1 To 2, 1 To 1)
beta(1, 1) = 0.510825624
beta(2, 1) = 0
X5(1, 1) = 1
X5(1, 2) = 45
X5(2, 1) = 1
X5(2, 2) = 76
Ycoded(1, 1) = 1
Ycoded(2, 1) = 0
For j = 1 To 2
For k = 1 To 2
Xtempj(k, 1) = X5(j, k)
Next k
temp1(j, 1) = WorksheetFunction.MMult(Application.Transpose(beta), Xtempj) * Ycoded(j, 1)
Next j
End Sub
This error message makes me think that VBA is thinking of Ycoded(j,1) as a 1 x 1 array. Therefore, I also tried the following statement:
temp1(j, 1) = WorksheetFunction.MMult(WorksheetFunction.MMult(Application.Transpose(beta), Xtempj), Ycoded(j, 1))
However, here I receive the "Unable to get the MMult property of the WorksheetFunction class".
I can do this kind of thing in R or SAS Proc IML in my sleep, so this is VERY frustrating. Any assistance/insight is appreciated.
Best,
Dan

For the partic instance shown, it is considered an array being returned and therefore is expecting you to index into that array e.g.
temp1(j, 1) = Ycoded(j, 1) * WorksheetFunction.MMult(Application.Transpose(beta), Xtempj)(1)
MMULT otherwise expects equal rows in one array to equal columns in the other array.
WorksheetFunction.MMult(Application.Transpose(beta), Xtempj) is producing a variant(1 to 1). You index into that with (1) to access the value.

Related

Is there a way to avoid Type MisMatch Error in EXCEL VBA when iterating through an Array?

I have the following code throwing a Type MisMatch Error on the line highlighted below. The code is supposed to simply identify empty elements in the input array (stat5) and replace them with a single period in the output array (ArrayOut). However, when it encounters the empty element in position (9,2) of stat5, it throws the Type MisMatch error:
From what I have read about the Type MisMatch error, it sounds like data assigned to a variable does not match the type of the variable. However, in my case, I am encountering the error EVEN when I attempt to simply call the value of stat5(9,1) in the Debug.Print statement below. It hangs on the Print statement (which is not an assignment statement, so I can't figure out what is mismatching with what):
Here is the code:
ReDim ArrayOut(1 To X1N, 1 To 1)
For i2 = 1 To X1N
If Len(Trim(stat5(i2, 2))) = 0 Then
ArrayOut(i2, 1) = "."
Else
ArrayOut(i2, 1) = stat5(i2, 2)
End If
Next i2
Here is the data in the input array (In this particular case, the non-missing values of the 2nd column of the array are constant, but this is not always the case). These are the values of stat5 when the error occurs in iteration 9 of the loop:
1 0.500285714
2 0.500285714
3 0.500285714
4 0.500285714
5 0.500285714
6 0.500285714
7 0.500285714
8 0.500285714
9
10 0.500285714
=========================================================
Here is the code that sets up stat5. All of this code runs without error:
Dim stat1 As Variant
Dim stat2 As Variant
Dim stat3 As Variant
Dim stat4 As Variant
Dim stat5 As Variant
'ReCombine Results for Final Printing
'Add ObsNum to each
'Prediction Set Results
ReDim stat1(1 To X3N, 1 To 2)
For i2 = 1 To X3N
stat1(i2, 1) = X3(i2, 1)
If Pred = True Then
If NumberOfArrayDimensions(ArrayPredIn) = 1 Then
stat1(i2, 2) = ArrayPredIn(i2)
Else
stat1(i2, 2) = ArrayPredIn(i2, 1)
End If
Else
stat1(i2, 2) = ""
End If
Next i2
'Estimation Set ResultS
ReDim stat2(1 To UBound(X4, 1), 1 To 2)
If NumberOfArrayDimensions(ArrayEstIn) = 1 Then
For i2 = 1 To UBound(X5, 1)
stat2(i2, 1) = X4(i2, 1)
stat2(i2, 2) = ArrayEstIn(i2)
Next i2
Else
For i2 = 1 To UBound(X5, 1)
stat2(i2, 1) = X4(i2, 1)
stat2(i2, 2) = ArrayEstIn(i2, 1)
Next i2
End If
'Concatenate stat1, stat2, stat3
ReDim stat5(1 To X1N, 1 To 2)
stat5 = Combine(stat1, stat2)
QuickSortArray stat5, , , 1
Here is the Combine function:
Function Combine(a As Variant, b As Variant, Optional stacked As Boolean = True) As Variant
'assumes that A and B are 2-dimensional variant arrays
'if stacked is true then A is placed on top of B
'in this case the number of rows must be the same,
'otherwise they are placed side by side A|B
'in which case the number of columns are the same
'LBound can be anything but is assumed to be
'the same for A and B (in both dimensions)
'False is returned if a clash
Dim lb As Long, m_A As Long, n_A As Long
Dim m_B As Long, n_B As Long
Dim m As Long, N As Long
Dim C As Variant
If TypeName(a) = "Range" Then a = a.value
If TypeName(b) = "Range" Then b = b.value
lb = LBound(a, 1)
m_A = UBound(a, 1)
n_A = UBound(a, 2)
m_B = UBound(b, 1)
n_B = UBound(b, 2)
If stacked Then
m = m_A + m_B + 1 - lb
N = n_A
If n_B <> N Then
Combine = False
Exit Function
End If
Else
m = m_A
If m_B <> m Then
Combine = False
Exit Function
End If
N = n_A + n_B + 1 - lb
End If
ReDim C(lb To m, lb To N)
For i = lb To m
For j = lb To N
If stacked Then
If i <= m_A Then
C(i, j) = a(i, j)
Else
C(i, j) = b(lb + i - m_A - 1, j)
End If
Else
If j <= n_A Then
C(i, j) = a(i, j)
Else
C(i, j) = b(i, lb + j - n_A - 1)
End If
End If
Next j
Next i
Combine = C
End Function
=========================================================================
UPDATE: When I check the type of each element of stat5, the type of element (9,2) is 8204 (while all the other (i2,2) elements are 5 = vbdouble). However, I'm not sure what this means: Has a multi-element array been saved to the (9,2) element of the array stat5? Is that possible?
I tried wrapping all of the calls to stat5(i2,2) with CStr(), hoping to convert the info in (9,2) to a string, but this also gives the same Type MisMatch error.
Locals window output:
===============================================================================
Results from the Locals window:
However, the variable type according to VarType() for elements (1-8,2) is vbDouble ("5") which seems to contradict the results in the Locals window:
===============================================================================
UPDATE: I was able to reproduce the error with stat1 BEFORE the Combine function was used to create stat5. Therefore, I do not believe that the problem is with the Combine function.

Only first element in 2D array is being returned - incorrect usage of ReDim?

I have a 2D array:
Dim twod_array() As Variant
Which I want to store values from two other arrays: e.g.:
Dim arrayone As Variant
arrayone = (1, 2, 3)
Dim arraytwo As Variant
arraytwo = (4, 5, 6)
I want to loop through each element of the above arrays and add them in the below manner:
Dim count As Long
count = 0
ReDim Preserve twod_array(1,0) // initial sizing
for i = 0 To UBound(arrayone)
for j = 0 To UBound(arraytwo)
twod_array(0,count) = arrayone(i)
twod_array(1,count) = arraytwo(j)
count = count + 1
ReDim Preserve twod_array(1, count) // dynamic resizing (doesnt work)
Next j
Next i
I know at some point I have to ReDim the 2D array which I believe I can do as follows:
ReDim Preserve twod_array(1, count)
The 1 allows me to specify 2 elements in the x-dimension and the count is incremented because I don't know how many elements each one-d array will have (I just set them equal to three in this example)
For some reason, I can only output the values twod_array(0,0) to twod_array(1,0) and the other ones are blank. I suspect this has to do with how I used ReDim
e.g. right now I'm only getting:
twod_array(0,0) = 1
twod_array(1,0) = 4
but not:
twod_array(0,1) = 1
twod_array(1,1) = 5
instead I get:
twod_array(0,1) = //blank
twod_array(1,1) = //blank
Can someone please help me understand why my code is not resizing the 2D array correctly so I can output all elements it collects?
maybe you're after this:
Option Explicit
Sub arrays()
Dim arrayOne As Variant, arrayTwo As Variant
arrayOne = Array(1, 2, 3)
arrayTwo = Array(4, 5, 6)
Dim i As Long
ReDim twod_array(1, UBound(arrayOne)) As Variant ' array sizing
For i = 0 To UBound(arrayOne)
twod_array(0, i) = arrayOne(i)
twod_array(1, i) = arrayTwo(i)
Next
End Sub
which outputs your desired output:
twod_array(0,0) = 1
twod_array(1,0) = 4
and
twod_array(0,1) = 2
twod_array(1,1) = 5

How do I generate a regression on excel vba?

I'm trying to generate a linear and quadratic regression of some data I have using vba. Simple enough right? The problem is when I use the linest function, I'm not getting the results I was hoping for (a 2d array containing the x values in the first column and the y values in the second column), and instead I'm receiving "Error 2015".
I know that linest is supposed to return the coefficients of a linear/quadratic regression, so I tried just creating a y=mx+b in my code to generate the arrays I want. I have yet to find success doing this.
Avg & P2 are the variables for the input data.
Dim lin() As Variant 'linear regression'
Dim quad() As Variant 'polynomial regression'
Dim RMSE1 As Single 'RMSE of linear regression'
Dim RMSE2 As Single 'RMSE of quadratc regression'
Dim nAvg() As Variant 'Avg values being looked at in current loop'
Dim nP2() As Variant 'P2 values being looked at in current loop'
Dim k As Single 'Ratio of RMSE1/RMSE2'
Dim linEstOut() As Variant
Dim linSlope As Single
Dim linB As Single
Dim quadEstOut() As Variant
Dim quadSlope As Single
Dim quadB As Single
Dim quadC As Single
For i = 2 To UBound(P2)
ReDim Preserve lin(i)
ReDim Preserve quad(i)
ReDim Preserve nAvg(i)
ReDim Preserve nP2(i)
ReDim Preserve linEstOut(i)
ReDim Preserve quadEstOut(i)
nAvg(1) = Avg(1)
nP2(1) = P2(1)
nAvg(i) = Avg(i)
nP2(i) = P2(i)
'linear regression'
linEstOut(i) = Application.LinEst(nAvg, nP2, 1, 0) 'linest returns a slope'
linSlope = linEstOut(1)
linB = linEstOut(2)
For j = 1 To UBound(lin)
lin(j) = (linSlope * nP2(j)) + linB
Next j
'quadratic regression'
quadEstOut = Application.LinEst(nAvg, Application.Power(nP2, Array(1, 2)), True, False)
quadSlope = quadEstOut(1)
quadB = quadEstOut(2)
quadC = quadEstOut(3)
For j = 1 To UBound(quad)
quad = (quadSlope * nP2(i) ^ 2) + (quadB * nP2(i)) + quadC
Next j
'RMSE'
RMSE1 = (Application.WorksheetFunction.SumSq(lin) / i) ^ (1 / 2)
RMSE2 = (Application.WorksheetFunction.SumSq(quad) / i) ^ (1 / 2)
'Calculate K value'
k = RMSE1 / RMSE2 'Greater than 1, non linear; close to 1, linear'
'Determine if the region is linear or quadtratic'
If k > 1 Then
tpx = nP2(i) 'turning point x'
tpy = nAvg(i) 'turning point y'
Exit For
Else
End If
Next i
I have not gotten any output besides error messages yet. The desired output is two arrays containing the y-values of the linear/quadratic regression.
Regarding the code you have in your question: When dealing with regressions, you have to be aware that by default VBA arrays are starting at 0 and you need to specify when you (re)dim them that you want them to start at 1 which is the convention when doing regressions.
In you code, when you were running the line below, you had an empty value for nAvg(0) and nP2(0) which gave you the Error 2015 (#Value cell error).
linEstOut(i) = Application.LinEst(nAvg, nP2, 1, 0)
Hence, for anything that will contain regression data, I would suggest doing to redim them like this
ReDim Preserve nAvg(1 to i)
ReDim Preserve nP2(1 to i)
Side note: you could also Option Base 1 at the top of your module to override the default at the module level, but your macros will start breaking if you copy them to other modules, so that is not recommended.
Regarding your comment and the second part of your question:
For how to generate a polynomial regression with VBA, you can have a look at this answer.

Excel VBA minverse

When I have defined matrix as Dim M(1 To 6, 1 To 6) I can easily use function Application.WorksheetFunction.Minverse(M)
But if I want to use dynamic array Dim M() and later using Redim K(6,6) I get an error "Runtime Error '1004' Unable to get minverse property of the WorksheetFunction class".
Am I doing something wrong or it is not possible to get matrix inverse using Minverse on a dynamic array?
A quick test:
Sub test()
Dim M As Variant
Dim i As Long, j As Long
ReDim M(1 To 2, 1 To 2) As Double
M(1, 1) = 5
M(1, 2) = 5
M(2, 2) = 3
M = Application.WorksheetFunction.MInverse(M)
For i = 1 To 2
For j = 1 To 2
Debug.Print M(i, j)
Next j
Next i
End Sub
Output:
0.2
-0.333333333333333
0
0.333333333333333
So, no, there is no problem using that function on dynamic arrays. Perhaps you had a typo? Alternatively, if there is no inverse (in e.g. in the above example remove the line M(2,2) = 3) you do get that error message. If this is an issue, you could use error-handling to trap that error.

Simple Histogram in VBA?

I have data stored in some column (Say, Column A). The length of Column A is not fixed (depends on previous steps in the code).
I need a histogram for the values in Column A, and have it in the same sheet. I need to take the values in column A, and automatically compute M Bins, then give the plot.
I looked online for a "simple" code, but all codes are really fancy, with tons of details that I don't need, to the extent that I am not even able to use it. (I am a VBA beginner.)
I found the following code that seems to do the job, but I am having trouble even calling the function. Besides, it only does computations but does not make the plot.
Sub Hist(M As Long, arr() As Single)
Dim i As Long, j As Long
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Single
For i = 1 To M
freq(i) = 0
Next i
Length = (arr(UBound(arr)) - arr(1)) / M
For i = 1 To M
breaks(i) = arr(1) + Length * i
Next i
For i = 1 To UBound(arr)
If (arr(i) <= breaks(1)) Then freq(1) = freq(1) + 1
If (arr(i) >= breaks(M - 1)) Then freq(M) = freq(M) + 1
For j = 2 To M - 1
If (arr(i) > breaks(j - 1) And arr(i) <= breaks(j)) Then freq(j) = freq(j) + 1
Next j
Next i
For i = 1 To M
Cells(i, 1) = breaks(i)
Cells(i, 2) = freq(i)
Next i
End Sub
And then I try to call it simply by:
Sub TestTrial()
Dim arr() As Variant
Dim M As Double
Dim N As Range
arr = Range("A1:A10").Value
M = 10
Hist(M, arr) ' This does not work. Gives me Error (= Expected)
End Sub
A little late but still I want to share my solution. I created a Histogram function which might be used as array formula in the excel spread sheet. Note: you must press
CTRL+SHIFT+ENTER to enter the formula into your workbook. Input is the range of values and the number M of bins for the histogram. The output range must have M rows and two columns. One column for the bin value and one column for the bin frequency.
Option Explicit
Option Base 1
Public Function Histogram(arr As Range, M As Long) As Variant
On Error GoTo ErrHandler
Dim val() As Variant
val = arr.Value
Dim i As Long, j As Integer
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Integer
Dim min As Single
min = WorksheetFunction.min(val)
Dim max As Single
max = WorksheetFunction.max(val)
Length = (max - min) / M
For i = 1 To M
breaks(i) = min + Length * i
freq(i) = 0
Next i
For i = 1 To UBound(val)
If IsNumeric(val(i, 1)) And Not IsEmpty(val(i, 1)) Then
If val(i, 1) > breaks(M) Then
freq(M) = freq(M) + 1
Else
j = Int((val(i, 1) - min) / Length) + 1
freq(j) = freq(j) + 1
End If
End If
Next i
Dim res() As Variant
ReDim res(M, 2)
For i = 1 To M
res(i, 1) = breaks(i)
res(i, 2) = freq(i)
Next i
Histogram = res
ErrHandler:
'Debug.Print Err.Description
End Function
Not 100% sure as to the efficacy of that approach but;
Remove the parens as your calling a sub; Hist M, arr
M is declared as double but received by the function as a long; this won't work so declare it in the calling routine as long
You will need to recieve arr() As Variant
Range -> Array produces a 2 dimensional array so the elements are arr(1, 1) .. arr(n, 1)

Resources