Question 01: - Evaluate & Replace for array
There is a code line:
x1 = Evaluate(Replace(fxn1, "x", x))
In which: fxn1 is string, says "x^2". The code line works fine for scalar value of x. However, when I go for x as matrix of (mxn) or even (nx1). It doesn't work.
Is there any way to make that code work?
My solution is using a loop to perform for every element in x. However, I don;t think this way is efficient.
Question 02: Loop for above problem
This is my temporary solution for my question above. It is not efficient.
The function works fine. However, when I use a sub to call that function. It does not works.
Here's the code:
Sub sample()
Dim fxn As String
Dim x() As Variant
Dim y() As Variant
fxn = "x^2"
x = Range("A1:A10")
y = fnarray("x^2", x)
Range("L1:L10") = y
End Sub
Function fnarray(fn As String, x As Variant)
Dim nr As Integer, nc As Integer
Dim i As Integer, j As Integer
Dim y
nr = x.Rows.Count
nc = x.Columns.Count
ReDim y(nr, nc) As Variant
For i = 1 To nr
For j = 1 To nc
y(i, j) = Evaluate(Replace(fn, "x", x(i, j)))
Next j
Next i
fnarray = y
End Function
Related
I would like to make a user-defined function union in VBA, such that:
it could take variable parameters
each parameter is a one-column range like A1, A2:A10; we don't need to consider passing constant values to parameters
we could consider, within one input range, there are no duplicates; but it is very possible to have duplicates among input ranges.
union combines the input ranges, and keeps the order of the elements. For instance, =union(A1:A5, C1:C2, E1:E3) has the following expected output in Column I:
I wrote the following code which works. However, the problem is that it is slow. A union over a list of 4000 rows and a list of 20 rows takes already several seconds. First, I don't know the way I coded arrays could be improved. Second, the algorithm just consists in comparing each new element against the accumulating result list; there is no sort, no other techniques. Third, I don't know if there are any existing functions we could use in other objects of VBA (eg, VBA FILTER function, Collection, ArrayLists, Scripting.Dictionary).
Could anyone propose a more efficient code?
Function getDimension(var As Variant) As Long
On Error GoTo Err
Dim i As Long
Dim tmp As Long
i = 0
Do While True
i = i + 1
tmp = UBound(var, i)
Loop
Err:
getDimension = i - 1
End Function
Function exists(v As Variant, arr As Variant, resCount As Long) As Boolean
If resCount = 0 Then
exists = False
Else
exists = False
i = LBound(arr, 1)
Do While (i <= resCount) And (Not exists)
If arr(i) = v Then
exists = True
End If
i = i + 1
Loop
End If
End Function
' assumption: every input is a range (eg, A1, A1:A2)
' assumption: each input range has only one column
Function union(ParamArray arr() As Variant) As Variant
Dim res As Variant
ReDim res(1 To 100000)
Dim resCount As Long
resCount = 0
For k = LBound(arr) To UBound(arr)
Dim arrk As Variant
Dim v
arrk = arr(k).Value2
If getDimension(arrk) = 0 Then 'case of A1, B1
v = arrk
If Not exists(v, res, resCount) Then
resCount = resCount + 1
res(resCount) = v
End If
ElseIf getDimension(arrk) = 2 Then 'case of A1:A10, B1:B10
For i = LBound(arrk, 1) To UBound(arrk, 1)
v = arrk(i, 1)
If Not exists(v, res, resCount) Then
resCount = resCount + 1
res(resCount) = v
End If
Next i
End If
Next k
ReDim Preserve res(1 To resCount)
union = Application.WorksheetFunction.Transpose(res)
End Function
Something like this should work, using a Dictionary to eliminate duplicates.
Function UniqueValues(ParamArray arr() As Variant)
Dim r, c As Range, v, dict
Set dict = CreateObject("scripting.dictionary")
For Each r In arr
For Each c In r.Cells
v = c.Value
If Len(v) > 0 Then dict(v) = 1
Next c
Next r
UniqueValues = ToColumn(dict.keys)
End Function
Function ToColumn(arr)
Dim arrOut, i As Long
ReDim arrOut(1 To UBound(arr) + 1, 1 To 1)
For i = 1 To UBound(arr) + 1
arrOut(i, 1) = arr(i - 1)
Next i
ToColumn= arrOut
End Function
I wrote some code to collect numbers from a column then put those numbers within a specific range into another column on a different worksheet. The problem is that the ActiveX Command button that I'm using is private to the first worksheet. Here's the code:
Private Sub CommandButton1_Click()
Dim X As Integer
Dim Y As Integer
X = Range(J2).Value
Y = Range(K2).Value
RuntimeLR = Cells(Rows.Count, 4).End(xlUp).Row
If CommandButton1 = True Then
For I = 2 To RuntimeLR
If I >= X And I <= Y Then
Worksheets("Calculate Runtime").Cells(p + 1, 1) = I
p = p + 1
End If
Next I
End If
End Sub
Is there a way to make the ActiveX Control Button public? Thank you.
Private and Public only dictate where the code can be called from. In this case since it is an activeX command button event sub it exists on a worksheet's code behind. Only that button or subs in the same worksheet code behind can call it. So that isn't the issue.
There are three issues with the code here:
You need to declare all variables, or remove option explicit. option explicit is very handy though so don't remove it.
Range accepts strings (generally speaking), it thinks your Range(J2) means you have a variable called J2 you want Range("J2") to point to Cell J 2.
Your If will always be false, Command Buttons don't have a boolean for you to compare to like that. A checkbox or the like would, however.
All together:
Private Sub CommandButton1_Click()
Dim X As Long 'I made these longs, integer is worthless in VBA don't use it ever
Dim Y As Long
Dim runtimelr As Long
Dim i As Long
Dim p As Long
X = Range("J2").Value
Y = Range("K2").Value
runtimelr = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To runtimelr
If i >= X And i <= Y Then
Worksheets("Calculate Runtime").Cells(p + 1, 1) = i
p = p + 1
End If
Next i
End Sub
As an aside, your loop is not calculating run-time. It takes far less than 1 second for it to perform an iteration.
What you're looking for:
Dim X As Long
Dim Y As Long
Dim runtimelr As Long
Dim i As Long
Dim p As Long
X = Range("J2").Value
Y = Range("K2").Value
runtimelr = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To runtimelr
If Me.Cells(i, 4).Value >= X And Me.Cells(i, 4).Value <= Y Then
Worksheets("Calculate Runtime").Cells(p + 1, 1) = Me.Cells(i, 4).Value
p = p + 1
End If
Next i
Simply put, what I am attempting to do is a simple function that would calculate the sample variance of a selected range of cells in excel. The effect is to get a result exactly identical to the excel function =VAR.S()
I have coded in the user-defined function for mean (see below), but the error arises when trying to call my Mean1b function into my Var2a function. If I had simply defined mean as a constant in my variance formula, everything goes smoothly.
My question is, why am I not simply able to pass the input array through my Var2a function, such that it would be accepted by Mean1b function? What would also be the workaround this if I were to continue working in ParamArray?
Public Function Mean1b(ParamArray arr() As Variant)
Dim rtot As Double
Dim elem As Variant
Dim i As Integer
Dim count As Integer
rtot = 0 'set initial state
count = 0 'initiate count of elements in the array
For i = LBound(arr) To UBound(arr) 'loop from lower bound to upper bound of array
For Each elem In arr(i)
rtot = rtot + elem.Value
count = count + 1
Next elem
Next i
Mean1b = rtot / count
End Function
Public Function Var2a(ParamArray arr() As Variant) As Double
Dim rtot As Double
Dim elem As Variant
Dim i As Integer
Dim count As Integer
mean = Mean1b(arr)
rtot = 0
count = 0
For i = LBound(arr) To UBound(arr)
For Each elem In arr(i)
rtot = rtot + (elem.Value - mean) ^ 2
count = count + 1
Next elem
Next i
Var2a = rtot / (count - 1)
End Function
Solved it! Turns out all you had to do was to modify this:
mean = Mean1b(arr)
to this:
mean = Mean1b(arr(0))
Apparently this is required when passing a ParamArray into another function
I'm writing a custom function with the goal of performing multiplications of multiple arrays containing complex numbers in Excel. As an example, I have these 3 arrays defined on my Excel worksheet:
MATZ1:
0.99995021721684+0.0172827928509254i -0.040624595514759-0.000234038263707613i
0.00490168593281832-0.850839538828158i 0.99995021721684+0.0172827928509254i
MATZ2:
0.996262283629251+0.149720806155247i -0.952677113437938-0.0475875415517989i
0.0156809592632005-0.313924412139317i 0.996262283629251+0.149720806155247i
MATZ3:
0.998558978121825+0.0929765994909912i -0.128534373384092-0.00398493017536902i
0.0448308688243513-1.44602474297277i 0.998558978121825+0.0929765994909912i
And I have written the following function in VBA:
Function IMATMULT(rng1 As Range, rng2 As Range) As Variant
Dim i As Integer
Dim j As Integer
Dim l As Integer
Dim temp As String
Dim NumColumns As Variant
Dim NumRows As Variant
Dim NumRows2 As Variant
NumRows = rng1.Rows.Count - 1
NumColumns = rng2.Columns.Count - 1
If (rng1.Columns.Count = rng2.Rows.Count) Then
NumRows2 = rng1.Columns.Count
Else
IMATMULT = "non compatible arrays"
Exit Function
End If
Dim matrix() As String
ReDim matrix(NumRows, NumColumns)
For i = 0 To NumRows
For j = 0 To NumColumns
temp = "0"
For l = 1 To NumRows2
temp = WorksheetFunction.ImSum(temp, WorksheetFunction.ImProduct(rng1(i + 1, l).Value, rng2(l, j + 1).Value))
Next l
matrix(i, j) = temp
Next j
Next i
IMATMULT = matrix()
End Function
Which is able to multiply two complex arrays together. When I write the folowing code line in Excel, I get the correct result:
However, when I try to multiply more than two arrays, I get an error result:
I know I could just simply do the multiplication one array at a time, but I'd like to know why using my function twice doesn't work, as my current knowledge of VBA doesn't allow me to understand the reason for it.
Many thanks.
EDIT1:
It would seem the problem is that the output from this function is a different format than the input. To work as I need it, this function needs to accept an array of text as input. However, I have no idea how to pass such an array into a function, any help would be welcome.
I have a 2D array of type Variant. The size and values that populate the array are generated based on data within a worksheet. Further processing is required on this array, the primary being the interpolation of several values. I am using this interpolation function (I know about excel equivalent functions but a design choice was made not to use them) . The problem I am having is the that the Interpolation function requires a Range object.
I have already tried modifying the function to use a Variant (r as Variant) argument. The following line nR = r.Rows.Count can be replaced with nR = Ubound(r). While this works, I would also like to use this function normally within any worksheet and not change the function in any way.
Sub DTOP()
Dim term_ref() As Variant
' snip '
ReDim term_ref(1 To zeroRange.count, 1 To 2)
' values added to term_ref '
' need to interpolate x1 for calculated y1 '
x1 = Common.Linterp(term_ref, y1)
End Sub
Interpolation Function
Function Linterp(r As Range, x As Double) As Double
Dim lR As Long, l1 As Long, l2 As Long
Dim nR As Long
nR = r.Rows.Count
' snipped for brevity '
End Function
How do I convert my in-memory variant array to a Range so that it can be used for the interpolate function? (without outputting to a WorkSheet)
Answer
In short, the answer is you can't. A Range object must reference a worksheet.
The changed interpolation function checks the TypeName of the argument and sets the value of nR accordingly. Not the prettiest solution.
As a note, the VarType function proved useless in this situation since both VarType(Variant()) and VarType(Range) returned the same value (i.e vbArray) and could not be used to disambiguate an array from a range
Function Linterp(r As Variant, x As Variant) As Double
Dim lR As Long, l1 As Long, l2 As Long
Dim nR As Long
Dim inputType As String
inputType = TypeName(r)
' Update based on comment from jtolle
If TypeOf r Is Range Then
nR = r.Rows.Count
Else
nR = UBound(r) - LBound(r) 'r.Rows.Count
End If
' ....
End Function
AFAIK, you can't create a Range object that doesn't in some way reference a worksheet location your workbook. It can be something dynamic, liked a Named =OFFSET() function, for example, but it has to tie back to a worksheet somewhere.
Why not change the interpolation function? Keep your Linterp signature as is, but make it into a wrapper for a function that interpolates on an array.
Something like this:
Function Linterp(rng As Range, x As Double) As Double
' R is a two-column range containing known x, known y
' This is now just a wrapper function, extracting the range values into a variant
Linterp = ArrayInterp(rng.Value, x)
End Function
Function ArrayInterp(r As Variant, x As Double) As Double
Dim lR As Long
Dim l1 As Long, l2 As Long
Dim nR As Long
nR = UBound(r) ' assumes arrays are all 1-based
If nR = 1 Then
' code as given would return 0, better would be to either return
' the only y-value we have (assuming it applies for all x values)
' or perhaps to raise an error.
ArrayInterp = r(1, 2)
Exit Function
End If
If x < r(1, 1) Then ' x < xmin, extrapolate'
l1 = 1
l2 = 2
ElseIf x > r(nR, 2) Then ' x > xmax, extrapolate'
l2 = nR
l1 = l2 - 1
Else
' a binary search might be better here if the arrays are large'
For lR = 1 To nR
If r(lR, 1) = x Then ' no need to interpolate if x is a point in the array'
ArrayInterp = r(lR, 2)
Exit Function
ElseIf r(lR, 2) > x Then ' x is between tabulated values, interpolate'
l2 = lR
l1 = lR - 1
Exit For
End If
Next
End If
ArrayInterp = r(l1, 2) _
+ (r(l2, 2) - r(l1, 2)) _
* (x - r(l1, 1)) _
/ (r(l2, 1) - r(l1, 1))
End Function
here's a function to create a range in a new sheet. You can modify this function by adding another range parameter to provide the starting point for the cell range to hold your array.
Put in the code as is at first and walk thru Sub Test() using debugger to see what it can do for you ...
Function Array2Range(MyArray() As Variant) As Range
Dim X As Integer, Y As Integer
Dim Idx As Integer, Jdx As Integer
Dim TmpSht As Worksheet, TmpRng As Range, PrevRng As Range
X = UBound(MyArray, 1) - LBound(MyArray, 1)
Y = UBound(MyArray, 2) - LBound(MyArray, 2)
Set PrevRng = Selection
Set TmpSht = ActiveWorkbook.Worksheets.Add
Set TmpRng = TmpSht.[A1]
For Idx = 0 To X
For Jdx = 0 To Y
TmpRng(Idx + 1, Jdx + 1) = MyArray(LBound(MyArray, 1) + Idx, LBound(MyArray, 2) + Jdx)
Next Jdx
Next Idx
Set Array2Range = TmpRng.CurrentRegion
PrevRng.Worksheet.Activate
End Function
Sub Test()
Dim MyR As Range
Dim MyArr(3, 3) As Variant
MyArr(0, 0) = "'000"
MyArr(0, 1) = "'0-1" ' demo correct row/column
MyArr(1, 0) = "'1-0" ' demo correct row/column
MyArr(1, 1) = 111
MyArr(2, 2) = 222
MyArr(3, 3) = 333
Set MyR = Array2Range(MyArr) ' to range
Range2Array MyR, MyOther ' and back
End Sub
EDIT =============
ammended sub test() to demo conversion back into array and added quick & dirty piece of code to convert back range into array
Sub Range2Array(MyRange As Range, ByRef MyArr() As Variant)
Dim X As Integer, Y As Integer
Dim Idx As Integer, Jdx As Integer
Dim MyArray() As Variant, PrevRng As Range
X = MyRange.CurrentRegion.Rows.Count - 1
Y = MyRange.CurrentRegion.Columns.Count - 1
ReDim MyArr(X, Y)
For Idx = 0 To X
For Jdx = 0 To Y
MyArr(Idx, Jdx) = MyRange(Idx + 1, Jdx + 1)
Next Jdx
Next Idx
MyRange.Worksheet.Delete
End Sub