Excel VBA: Transpose Vector and Matrix Multiply in a function - excel

I have an 3x3 matrix "mat" and a vector "vec" (3x1) of real numbers I want to matrix multiply (in the linear algebra sense) in a VBA function like so: t(vec)matvec to produce a 1x1 real number I can use in an equation.
I do not want to interact with a worksheet in the function. The values in the matrix and vector are eiter hard-coded or calculated from within the function. There should be a simple way to transpose then do a couple matrix multiplications like in MATLAB or R. Here is where I am so far:
Public Function QuickMaths()
Dim vec As Variant
Dim mat As Variant
mat = Array(Array(1,1+1,3), _
Array(2^2,5,6), _
Array(7,8,9))
vec = Array(2*5,11,12)
QuickMaths = Application.WorksheetFunction.MMult(Application.WorksheetFunction.MMult(Application.WorksheetFunction.Transpose(vec), mat), vec)
End Function
I get #VALUE from this in a worksheet when I run it. I would expect the output to be a 1x1 matrix, but I don't know if Excel VBA would consider that a scalar that can be output into a sheet as a single value (e.g. Double).
Please send help.

It would have been good if you had provided expected output (the specific scalar you're expecting at the end).
Based on what I gather from your code and question, I'm going to assume you're trying to perform two steps. The first being:
The second being:
(It's been a while since I've done any matrix multiplication, so if you think I've misunderstood, let me know.)
Your first array (mat) is an array of arrays (not a two dimensional array), which I don't think MMULT handles (https://support.office.com/en-us/article/mmult-function-40593ed7-a3cd-4b6b-b9a3-e4ad3c7245eb). So you might need to replace:
mat = Array(Array(1, 1 + 1, 3), _
Array(2 ^ 2, 5, 6), _
Array(7, 8, 9))
with:
ReDim mat(0 To 2, 0 To 2)
mat(0, 0) = 1
mat(0, 1) = 2
mat(0, 2) = 3
mat(1, 0) = 4
mat(1, 1) = 5
mat(1, 2) = 6
mat(2, 0) = 7
mat(2, 1) = 8
mat(2, 2) = 9
That said, manually assigning each array element can be impractical, so maybe make a small function to do it for you (see FlattenAnArrayOfArrays function in code below).
From what I've read online in the last 30 minutes, matrix multiplication is not commutative and also requires that the number of columns in your first matrix match the number of rows in the second matrix. (You may already know all of this, but just mentioning it anyway.)
Based on the above, your code might look something like:
Option Explicit
Public Function QuickMaths() As Variant
' This function returns a value of type Variant.
' Could return a Long/Double/numeric type; scalar should be at QuickMaths(1,1)
' But MMULT can return non-numeric values, so you risk
' getting a type mismatch error if the matrix multiplication
' is not successful (for whatever reason).
' Maybe this shouldn't be this function's concern -- or maybe it should.
Dim mat As Variant
mat = Array(Array(1, 1 + 1, 3), _
Array(2 ^ 2, 5, 6), _
Array(7, 8, 9))
mat = FlattenAnArrayOfArrays(mat)
Dim vec As Variant
vec = Array(2 * 5, 11, 12)
Dim resultantMatrix As Variant
resultantMatrix = Application.MMult(vec, mat) ' Number of columns in "vec" must match number of rows in "mat"
resultantMatrix = Application.MMult(vec, Application.Transpose(resultantMatrix))
QuickMaths = resultantMatrix
End Function
Private Function FlattenAnArrayOfArrays(ByRef arrayOfArrays As Variant) As Variant()
' Given an array of arrays, returns a two-dimensional array.
' This function is very basic and has no error handling implemented.
Dim firstArray() As Variant
firstArray = arrayOfArrays(LBound(arrayOfArrays)) ' Columns inferred from first array in "arrayOfArrays"
Dim outputArray() As Variant
ReDim outputArray(LBound(arrayOfArrays) To UBound(arrayOfArrays), LBound(firstArray) To UBound(firstArray))
Dim rowIndex As Long
For rowIndex = LBound(outputArray, 1) To UBound(outputArray, 1)
Dim columnIndex As Long
For columnIndex = LBound(outputArray, 2) To UBound(outputArray, 2)
outputArray(rowIndex, columnIndex) = arrayOfArrays(rowIndex)(columnIndex)
Next columnIndex
Next rowIndex
FlattenAnArrayOfArrays = outputArray
End Function
Closing points:
The return value of the QuickMaths function is a 1x1 matrix, but you can assign it to a cell's value.
Similarly, if you call the QuickMaths function from a worksheet cell, the cell will display the return value (without any issues or need for an array formula).

Related

Using a FOR loop within an Excel VBA Function

I created a simple function in MATLAB, and am trying to convert the function into Excel VBA function. My goal is to create an Excel formula =RT('range of dB levels', 'delta-time') and output the estimated reverberation time. The math is simple, see MATLAB code below:
function rr=RT(lvl_broad, dt)
n=12; %number of samples within slope calc
slope=zeros(length(lvl_broad), 1);
for i=1:length(lvl_broad)
if i<((n/2)+1) | i>length(lvl_broad)-(n/2)-1
slope(i)=0;
else
slope(i)=(lvl_broad(i+(n/2))-lvl_broad(i-(n/2)))/n;
end
end
min_slope=min(slope);
rr=abs(dt./min_slope)*60;
end
In excel, I modified/simplified this until I no longer got errors, however, the cell that I enter my 'RT' function in returns #VALUE and I do not know why. Does anything stand out in the code below? (note I changed the input range from lvl_broad to InterruptedNZ)
Function RT(InterruptedNZ, dt)
Dim Slope As Double
Slope = Slope(InterruptedNZ.Height, 1)
For i = 1 To InterruptedNZ.Height
If i < ((6) + 1) Or i > (InterruptedNZ.Height - (6) - 1) Then
Slope(i) = 0
Else
Slope(i) = (InterruptedNZ(i + (6)) - InterruptedNZ(i - (6))) / 12
End If
Next
End
min_slope = Application.WorksheetFunction.Min(Slope)
RT = Abs((dt / min_slope) * 60)
End Function
Here are some tips to translate MATLAB code into VBA code:
length()
If you are trying to get the dimensions of a range, you'll need to use the .Rows.Count or .Columns.Count properties on the range you are working with.
PERFORMANCE NOTE:
When you have a large enough range, it's a good idea to store the values of the range inside an array since you will reduce the number of times you access data from the sheets which can comme with lot of overhead. If so, you'll have to use ubound() and lbound().
zeros()
In VBA, there is no exact equivalent to the zeros() function in MATLAB. The way we would initialize an array of zeros would simply be by initializing an array of doubles (or another numerical type). And since the default value of a double is zero, we don't need to do anything else :
Dim Slope() As Double
ReDim Slope(1 To InterruptedNZ.Rows.Count)
Note that you cannot pass the dimensions in the Dim statement since it only accepts constants as arguments, so we need to create Slope as a dynamic array of doubles and then redimension it to the desired size.
Putting these two principles together, it seems like your code would look something like this:
Function RT(ByRef InterruptedNZ As Range, ByVal dt As Double)
Dim Slope() As Double
ReDim Slope(1 To InterruptedNZ.Rows.Count)
Dim i As Long
For i = 1 To InterruptedNZ.Rows.Count
If i < ((6) + 1) Or i > (InterruptedNZ.Rows.Count - (6) - 1) Then
Slope(i) = 0
Else
Slope(i) = (InterruptedNZ(i + (6)) - InterruptedNZ(i - (6))) / 12
End If
Next
Dim min_slope As Double
min_slope = Application.WorksheetFunction.Min(Slope)
RT = Abs((dt / min_slope) * 60)
End Function
Addtionnal notes:
Refering to cells from a range like this InterruptedNZ(i) works but it is good practice to be more specific like this (assuming column range) :
InterruptedNZ.Cells(i,1)
During my tests, I had a division by zero error since min_slope was zero. You might want to account for that in your code.

#VALUE error when dealing with long string in UDF in VBA(excel)

I've encountered #VALUE error when using an UDF returning an array with long strings (>256 symbols).
Sample Code:
Function longString() As Variant
Dim res(1 To 1, 1 To 2)
res(1, 1) = "hellohhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh\nhellohhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh\nhellohhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh\nhellohhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhellohh\n"
res(1, 2) = "world"
longString = res
End Function
When calling longString() as an array formula in a cell, the cell got #Value error, but through debugging, longString() returns without error.
how can i resolve this issue?
I believe you have run into one of the obscure limitations in the interactions between VBA and Excel.
One workaround would be to change the formula to return only a single element, and have the particular element as an argument in the UDF.
For example:
Option Explicit
Function longString(Optional R As Long = 1, Optional C As Long = 1)
Dim res(1 To 1, 1 To 2)
res(1, 1) = "hellohhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh\nhellohhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh\nhellohhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh\nhellohhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhellohh\n"
res(1, 2) = "world"
longString = res(R, C)
End Function
You could then call the function in any of the following ways:
=longString() <-- returns the first element
=longString(1,1) <-- returns the first element
=longString(1,2) <-- returns the second element
=longString(ROWS($1:1), COLUMNS($A:A)) <--could be dragged down and right to return an array of the elements

Counting rows in VBA excel

I'm designing a function in VBA of the form myFunction(x,y,z) where z is a table, and x can take the values of the column headings. As part of the function I need to find the number of rows in z.
I'm having problems with this, as everywhere I look suggests using length = z.Rows.Count, but when I try and output this value (as in, set myFunction = length), it produces a VALUE error. However, when I output myFunction = a which doesn't directly use length (it will eventually form part of an IF statement once I get it working), the function works fine. My code is below:
Public Function myFunction(x As String, y As Double, z As Range) As Double
Dim upper_threshold As Double
Dim lower_threshold As Double
Dim a As Double
Dim rates As Variant
Dim u As Byte
Dim l As Byte
Dim r As Byte
Dim length As Byte
a = 0
u = 2
l = 1
rates = Application.WorksheetFunction.Index(z, 1, 0)
r = Application.WorksheetFunction.Match(x, rates, 0)
length = z.rows.Count
upper_threshold = z(u, 1)
Do While y > upper_threshold
u = u + 1
l = l + 1
upper_threshold = z(u, 1)
lower_threshold = z(l, 1)
If y < upper_threshold Then
a = a + z(l, r) * (y - lower_threshold)
Else
a = a + z(l, r) * (upper_threshold - lower_threshold)
End If
Loop
myFunction = a
End Function
To test it out I also created another function:
Public Function myRows(myTable As Range) As Double
myRows = myTable.rows.Count
End Function
This one works fine on its own, but when I try to use it within the other function, I still get a VALUE error. I've tried declaring length as every type I can think of and it doesn't seem to help.
Can anyone see what's going on?
EDIT: I'm obviously not making myself very clear. The function without the two lines referring to length works as I intended. However, I need to add a bit of code to increase its functionality and this involves calculating the number of rows in the table z. When I add the two lines shown here into the function it continues to work, since it doesn't affect the output. However, if I then set the output to show length, i.e. change the penultimate line to myFunction = length it gives me a VALUE error. This leaves me with two options as far as I can see: either something else in the program is impacting on these two lines (some clashes of syntax or something), or I'm making a mistake in just assuming I can output length like that.
Your problem is with:
rates = Application.WorksheetFunction.Index(z, 1, 0)
Index only accepts a single row or column, otherwise you get a VALUE error.

Root Mean Square (rms) function in VBA?

So I'm calculating basic statistics in my worksheet and it includes code such as:
xxx = Application.worksheetfunction.average(etc etc etc
yyy = Application.worksheetfunction.min(etc etc etc
zzz = Application.worksheetfunction.max(etc etc etc
My question: Is there an RMS equivalent function where I can simply plug it in place of where I have 'average, min, max' functions in that code? And if there isn't then what would be the most efficient means to code in to find RMS solutions?
I hope I've stated the goal clearly enough. I'm curious as to whether or not there is a predefined RMS function for VBA or whether or not I've got to create some sort of user defined function? ~ That of which I'm fairly new to as well so if there isn't a simple line of code to write for this, I'll have to do more reading on UDF's.
EDIT:
I've got around 30,000 rows, and for simplicity's sake: imagine two columns. Column A has the year i.e. 1941 or anything else through 2008. Column B is a numeric value. I'm just trying to put code together that gives decade summaries of Average, Min, Max, and the RMS values.
You can do the average with
=SQRT(SUMSQ(A:A)/COUNTA(range))
or in VBA:
r = (Application.WorksheetFunction.SumSq(Range("A:A")) / Range("A:A").Count) ^ (1 / 2)
A VBA function that accepts arrays (any rank) and ranges with multiple areas (a discontinuous range like A4:B6,C11:D15), or even a union of ranges in a formula. It skips non number datatypes (including dates, boolean, blanks etc).
You can use it in VBA code, or as a UDF in a worksheet formula such as:
"=RMS(A1:A10)" (basic usage)
"=RMS(A1:A10,C1:C10)" (multiple ranges (or arrays for that matter))
"{=RMS({1,2,3,4})}" (array formula entered with Ctrl+shift+enter)
Function RMS(ParamArray args()) As Double
Dim arg, arr, area As Range, ss As Double, n As Long
For Each arg In args
If TypeOf arg Is Range Then
For Each area In arg.Areas
arr = area.value
If VarType(arr) < vbArray Then
queryRmsElements Array(arr), ss, n
Else
queryRmsElements arr, ss, n
End If
Next area
ElseIf VarType(arg) > vbArray Then
queryRmsElements arg, ss, n
Else
Err.Raise 1, "RMS", "Invalid Argument"
End If
Next arg
RMS = (ss / n) ^ 0.5
End Function
Private Sub queryRmsElements(ByRef elements, ByRef ss As Double, ByRef n As Long)
Static element As Variant
'Enumerate to cover rank > 1 (vs. Iterate)
For Each element In elements
Select Case VarType(element)
Case VbVarType.vbByte, _
VbVarType.vbCurrency, _
VbVarType.vbDecimal, _
VbVarType.vbDouble, _
VbVarType.vbInteger, _
VbVarType.vbLong, _
VbVarType.vbSingle
ss = element ^ 2 + ss
n = n + 1
Case Else
End Select
Next element
End Sub
This one worked for me:
Function RMS(Intervalo As Range)
Dim SomaQ As Double
Dim Tamanho As Integer
SomaQ = 0
Tamanho = Intervalo.Count
SomaQ = Application.WorksheetFunction.SumSq(Intervalo)
RMS = Sqr(SomaQ / Tamanho)
End Function

Excel VBA Passing in an array of 2D arrays

I am working with an array of 2D arrays in Excel VBA. I have a function...
Public Function constructStack(vbr() As Variant, hr As Integer) As stack
Where stack is a class I made. I have another function, in which I am calling constructStack from. here is the call:
Set stacks(i) = stack(i).constructStack(vbr(i), i)
vbr happens to be an array of 2D arrays. Seeing as vbr(i) would refer to a single 2D array of type variant, I'm confused why I'm getting the "Type mismatch: array or user-defined type expected," compile error.
It's almost as if the compiler doesn't realize that vbr() will be filled with 24 2D arrays, which is why it's giving me the compile error. Here is how I Dim vbr:
Dim vbr(1 To 24) As Variant
After declaring vbr, I eventually run this for loop which assigns each element of vbr a 2D array...
vb = GetVBRSorted
For j = 1 To 24
For i = 2 To 2000
If (vb(i, 1)(j) <> "") Then
lastFilleds(j) = i
End If
Next
Next
For j = 1 To 24
ReDim vbrTemp(1 To lastFilleds(j) - 1, 1 To 5)
For i = 2 To lastFilleds(j)
For k = 1 To 5
vbrTemp(i - 1, k) = vb(i, k)(j)
Next
Next
vbr(j) = vbrTemp
Next
GetVBRSorted returns the exact same type as vbr - an array of 2D arrays. If anyone has any input on this issue, it would be much appreciated.
Because each individual vbr(i) is a Variant, this is what you must declare as your parameter type. There is no magical compile-time sniffing to realise the Variant contains an array.
Use
Public Function constructStack(vbr As Variant, hr As Integer) As stack
Also see How can I use an optional array argument in a VBA procedure?.
the call you have .constructStack(vbr(i), i) is passing a single element of the array. If you want to pass the whole array then you would use .constructStack(vbr, i)

Resources