VBA: Summing a matrix - excel

Why doesn't this function work?
Type =funtest(2.1) in Excel and it'll give me #VALUE!.
Public Function funtest(a As Double) As Double
Dim z, j, i As Integer
Dim matrix(3, 3, 3) As Double
For z = 0 To 3 Step 1
For j = 0 To 3 Step 1
For i = 0 To 3 Step 1
matrix(z, j, i) = a
Next i, j, z
funtest = Application.WorksheetFunction.Sum(matrix)
End Function

WorksheetFunction.Sum will work with either a range or a 2 dimentional array. It errors because you are passing it a 3 dimensional array.
So, this works
Public Function funtest(a As Double) As Double
Dim z As Long, j As Long, i As Long
Dim matrix() As Double
ReDim matrix(0 To 3, 0 To 4)
For j = LBound(matrix, 1) To UBound(matrix, 1)
For i = LBound(matrix, 2) To UBound(matrix, 2)
matrix(j, i) = a
Next i, j
funtest = Application.WorksheetFunction.Sum(matrix)
End Function
Note I have modified your declarations slighly, see note at end of answer.
To sum higher dimensional arrays you will need to do some looping.
One option (which may or may not suit your overal requirements) is to declare your array slightly differently, as a so called Jagged Array.
Public Function funtest2(a As Double) As Double
Dim z As Long, j As Long, i As Long
Dim matrix() As Variant
Dim InnerMatrix(0 To 4, 0 To 4) As Double
' Dimension Jagged Array
ReDim matrix(0 To 4)
For i = LBound(matrix, 1) To UBound(matrix, 1)
matrix(i) = InnerMatrix
Next
'Load Data into matrix
For z = LBound(matrix) To UBound(matrix)
For j = LBound(matrix(z), 1) To UBound(matrix(z), 1)
For i = LBound(matrix(z), 2) To UBound(matrix(z), 2)
matrix(z)(j, i) = a
Next i, j, z
' Sum matrix
For z = LBound(matrix) To UBound(matrix)
funtest2 = funtest2 + Application.WorksheetFunction.Sum(matrix(z))
Next
End Function
This is an array of 2 dimensional arrays. The Sum is then applied to each of the inner arrays in turn. This way, at least you are only looping one dimension and not all three.
Note on Dim and Integer
You must specify all As Type's, otherwise variables default to Variant
In your code z and j will be Variants
Also, using Integer rather than Long is actually counter productive on a 32 bit OS: Long's will be slightly faster.

I'm going to take you literally when you say "I'm trying to solve the simple case of a (3,3,3) matrix with each element equal to some double, a". This will do that:
Public Function funtest(a As Double) As Double
funtest = 4*4*4*a
End Function

First, when you get #VALUE! this means there is an error, it can mean using a matrix that is not valid.
To answer your question, your code does not work because your syntax is not correct. The following function creates a matrix from values.
Function FQ_matrix_create(StartValue As Double, Interval As Double,
nrow As Long, ncol As Long) As Double()
Dim M() As Double
' Creates matrix with sequential element values with given row and
' column sizes. Fills matrix row-wise with numbers.
' - set Interval = 0 for constant element values
' - error input arguments nrow and ncol are not positive integers
To SUM the Values use:
Function FQ_matrix_element_sum(M() As Double, SumOption As
MatrixDirection) As Double()
' Returns the sum of elements of matrix M, either row or column wise
' - Rowwise sum returns a horizontal 1xNcol matrix
' - Columnwise sum returns a vertical 1 xNrow matrix
' - Element sum (all elements) returns a 1x1 matrix
' - error if M is not a matrix
' - error if SumOption is not 1 (nRowWiseSum) or 2 (nColWiseSum) or
3 (nElementSum)
To help you understand Matrix in Excel VBA, here is a good resource: http://finaquant.com/download/matrixvectorvba
Specifically, take a look at the PDF Download on the site.

Related

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.

Combination of N variables in VBA

Here I Have some complex combination problem for VBA in Excel.
I have n variable defined by starting value, stop value and steps.
N variables are double values basically like below.
Var1, Var2, Var3, .... VarN
start: 20, 1, 0.1, ....
stop : 100, 10, 1.0, ....
step : 10, 1, 0.1, ....
What is the most efficient (fast) way of generating combination of each variable like below:
20, 1, 0.1
20, 1, 0.2
20, 1, 0.3
...
...
...
100, 10, 0.8
100, 10, 0.9
100, 10, 1.0
I believe that there are all 900 combinations (=9x10x10) for this case.
More challenging part is that I need more flexible solution for N variable cases using double array like this (without involving any worksheet formula):
Private startValue() As Double ' start value of each variable
Private stopValue() As Double ' stop value of each variable
Private stepValue() As Double ' step value of each variable
Private combination() as double 'combination of all N variable
Private n as integer ' number of variable = N
ReDim startValue(1 To 1, 1 To n) As Double
ReDim stopValue(1 To 1, 1 To n) As Double
ReDim stepValue(1 To 1, 1 To n) As Double
I really appreciated for your kind help.
Kind regards.
Why you require 2 dimensional array if you want 3 arrays for startValue, stopValue and stepValue. Alternately, You can use only one 2-dimensional array
ReDim arrValue(0 To 2, 0 To n-1) As Double
where index 0 = Start, 1 = Stop, 2 = Step
Rather than creating an array and then assigning values to it, you can let Excel do the job by assigning a range to your variable (i.e. arrMyValues = Range("A2:C4")). But as in your case we don't know the last column, we first have to get the last column. We can get this by:
oWS.Cells(1, Columns.Count).End(xlToLeft).Column
This will return the number of columns used in your sheet. In this instance however, we need the name of the last column. To get that we first get the last column addres:
oWS.Cells(1, Columns.Count).End(xlToLeft).Address
We then split this address into an array so that we can get the column name:
arrColAddress = Split(oWS.Cells(1, Columns.Count).End(xlToLeft).Address, "$")
Now that we have the name of the last column, we can use the name with row count to pass the range into our variable. To get the row count for the sheet, we can use:
oWS.Cells(Rows.Count, "B").End(xlUp).Row
If we put all of this together (only thing I added was a worksheet object), we get:
Dim oWS as Worksheet : Set oWS = Worksheets("your worksheet name")
arrColAddress = Split(oWS.Cells(1, Columns.Count).End(xlToLeft).Address, "$")
arrMyValues = oWS.Range("A2:" & arrColAddress(1) & oWS.Cells(Rows.Count, "B").End(xlUp).Row)
Code is based on the table you provided
Here is a solution which should work for any number of variables:
'The following takes a 1-based variant area with 3 rows
'And n columns, where n is the number of variables
'The first row are start values, the second is stop, and the
'third is step-size.
'It returns a variant array consisting of all combos
Function MakeCombos(Vals As Variant) As Variant
Dim i As Long, j As Long, n As Long
Dim numCombos As Long
Dim combos As Variant, levels As Variant
Dim var As Double, varStep As Double, colStep As Long
If TypeName(Vals) = "Range" Then Vals = Vals.Value 'make into a VBA array if passed a range
n = UBound(Vals, 2)
ReDim levels(1 To n)
'first find the *number* of levels for each variable
numCombos = 1
For i = 1 To n
levels(i) = 1 + Round((Vals(2, i) - Vals(1, i)) / Vals(3, i))
numCombos = numCombos * levels(i)
Next i
ReDim combos(1 To numCombos, 1 To n)
'Now -- just fill in column by column in reverse order with some modular arithmetic
colStep = 1 'how often value is changed in column
For j = n To 1 Step -1
var = Vals(1, j)
varStep = Vals(3, j)
combos(1, j) = var
For i = 1 To numCombos - 1
combos(i + 1, j) = var + (Int(i / colStep) Mod levels(j)) * varStep
Next i
'before next pass theough outer loop, increase colStep so that
'in the next column will step more slowly
colStep = colStep * levels(j)
Next j
MakeCombos = combos
End Function
To test it, I started with a spreadsheet that looks like:
Then ran this code:
Sub test()
Range("F1:H900").Value = MakeCombos(Range("B2:D4"))
End Sub
After which the data in columns F:H starts with:
and 900 rows down ends with:

#Name and VBA function

Creating a new formula to more easily deal with weighted median. Function works as a sub but not as a Function. So values are parsed in the first range and weights in the second i.e. {10,20,15,30,15}, {1,2,0,3,4}
Not sure were the error is creaping in.
Function weightedMedian(valueRng As Range, weightRng As Range)
Dim weightValueArr(), valueArr() As Double
ReDim weightValueArr(Application.Sum(weightRng) - 1)
ReDim valueArr(valueRng.Rows.Count - 1)
For k = 0 To valueRng.Rows.Count - 1
valueArr(k) = valueRng(k + 1)
Next
Dim n, m As Integer
n = 0
m = 0
For Each j In weightRng
For i = 0 To j - 1
weightValueArr(m) = valueArr(n)
m = m + 1
Next
n = n + 1
Next
weightedMedian = Application.Median(weightValueArr)
End Function
You need to give the type of your function, unlike a sub, right at the start.
Function weightedMedian(valueRng As Range, weightRng As Range) As double
Of course, this is the only way to know what the type of value returned IS, since you never dim it or receive it as an argument.

How do I call a UDF that returns an array within another UDF?

I am having some trouble figuring out how to return an array within a UDF from another UDF. The one here is a simple exponential moving average UDF and I am trying to return the array into another UDF but I am getting #value error. I feel there is a simple solution that I am not seeing. All help is greatly appreciated, thanks.
Function ema(arg1 As Variant, ByVal lngth As Long) As Variant
x = arg1
dim avg As Double
avg = 1
Dim arrema As Variant
arrema = Array()
ReDim arrema(1 To UBound(x, 1), 1 To 1)
For j = 1 To (UBound(x, 1) - lngth)
For i = (1 + j - 1) To (lngth + j - 1)
avg = (WorksheetFunction.Index(x, i, 1) + 1) * avg
Next i
arrema(j, 1) = avg ^ (1 / lngth)
avg = 1
Next j
'ema = avg ^ (1 / lngth)
ema = arrema
End Function
Function test(arg2 As Variant, xlength As Long)
Dim arra As Variant
'Call ema(arg2, xlength)
Dim arr As Variant
arr = Array()
ReDim arr(1 To UBound(arg2, 1), 1 To 1)
arra = ema(arg2, xlength)
For i = 1 To UBound(arg2, 1) - xlength
arr(i, 1) = arra(i, 1)
Next i
test = arr
End Function
If you are calling test from a formula with a range as the arg1 parameter, then your problem is you are treating a Range as if it were an Array by calling UBound(arg2,1)
Change that to UBound(arg2.Value,1) and it will work.
Further explanation:
By declaring the arg# parameters as Variant allows the UDFs to be called with either Range's or Array's. It may be better to be specific by using either As Range or As Variant().
In Function ema this issue is avoided by the line x = arg1: If arg1 is a Range then this copies the default property of the Range which is the Value property to x, making x an array. If arg1 is an Array then it just copies that array into x.
Net result is Function ema can handle either Ranges or Arrays. There is another issue there though: WorksheetFunction.Index(x, i, 1) will fail with one dimensional Arrays. Change it to WorksheetFunction.Index(x, i) or better still Application.Index(x, i) to avoid this issue too.

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