I have a Custom User Function (UDF) that returns an array. I use it in an Array Formula on a large range of cells.
The length of the returned array is dependent on the function parameters.
This works great except one thing: When the length of the returned array is smaller than the range defined for the array-formula, the "out-of-range" entries are all set to #N/A.
Is there a way to either obtain the array-formula range inside the custom user function (so, if needed, I could prepare a larger array to return), or alternatively return some kind of an iterator (instead of the array) which is not limited in size and would return "" in case of out-of-range?
Here is a pretty dumb example......a UDF to return the first 7 primes in column form:
Public Function Primes()
'
' Array UDF to return the first 7 primes
'
Dim rN As Long, ary(1 To 7) As Long
Dim tdim As Long, i As Long
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
rN = Application.Caller.Rows.Count
tdim = wf.Max(rN, 7)
ReDim bry(1 To tdim, 1 To 1)
ary(1) = 1
ary(2) = 3
ary(3) = 5
ary(4) = 7
ary(5) = 11
ary(6) = 13
ary(7) = 17
For i = 1 To 7
bry(i, 1) = ary(i)
Next i
If tdim > 7 Then
For i = 8 To tdim
bry(i, 1) = ""
Next i
End If
Primes = bry
End Function
The UDF detects how many cells it has to fill and if that value exceeds 7, the balance is filled with blanks.
Related
I am trying to calculate the count of Unique values based on a condition.
For example,
For a value in column B, I am trying to count the Unique values in Column C through VBA.
I know how to do it using Excel formula -
=SUMPRODUCT((B2:B12<>"")*(A2:A12=32)/COUNTIF(B2:B12,B2:B12))
that value for 32 is dynamic - Programmatically I am calling them inside my vba code as Name
This is my code :
Application.WorksheetFunction.SumProduct((rng <> "") * (rng2 = Name) / CountIfs(rng, rng))
This is the sample data with the requirement
Alternatively, I Concatenated both the columns for keeping it simple and hoping to identify the Unique values which starts with name* method.
I don't know where I am going wrong. Kindly share your thoughts.
You may try something like this...
Function GetUniqueCount(Rng1 As Range, Lookup As String) As Long
Dim x, dict
Dim i As Long, cnt As Long
Set dict = CreateObject("Scripting.Dictionary")
x = Rng1.Value
For i = 1 To UBound(x, 1)
If x(i, 1) = Lookup Then
dict.Item(x(i, 1) & x(i, 2)) = ""
End If
Next i
GetUniqueCount = dict.Count
End Function
Then you can use it like below...
=GetUniqueCount($A$2:$B$10,C2)
Where A2:B10 is the data range and C2 is the name criteria.
I'd put the values into an array, create a temporary 2nd array and only add values to this array if they are not already present, and then replace the original array. Then it's just a simple matter to sum the unique values:
Sub Unique
dim arr(10) as variant, x as variant
dim arr2() as variant
for x = 1 to 10 ' or whatever
arr(x) = cells(x, 1) ' or whatever
next x
arr2 = UniqueValuesArray(arr)
' now write some code to count the unique values, you get the idea
End Sub
Function UniqueValuesArray(arr As Variant) As Variant()
Dim currentRow, arrpos As Long
Dim uniqueArray() As Variant
Dim x As Long
arrpos = 0
ReDim uniqueArray(arrpos)
For x = 0 To UBound(arr)
If UBound(Filter(uniqueArray, arr(x))) = -1 Then
ReDim Preserve uniqueArray(arrpos)
uniqueArray(arrpos) = arr(x)
arrpos = arrpos + 1
End If
Next x
UniqueValuesArray = uniqueArray
End Function
Situation
I have a UDF that works with a range that it is passed that is of variable height and 2 columns wide. The first row will contain text in column 1 and an empty column2. The remainder of column 1 will contain unsorted text with an associated value in the same row in column 2. I need to sort the data such that if some text in column 1 also appears in some other text in column.
Problem
My VBA skills are all self taught and mimimal at best. I remember a few decades ago in university we did bubble sorts and played with pointers, but I no longer remember how we achieved any of that. I do well reading code but creating is another story.
Objective
I need to generate a sort procedure that will produce unique text towards the bottom of the list. I'll try wording this another way. If text in column1 can be found within other text in column, that the original text need to be placed below the other text it can be found in along with its associated data in column 2. The text is case sensitive. Its not an ascending or descending sort.
I am not sure if its a restriction of the UDF or not, but the list does not need to be written back to excel, it just needs to be available for use in my UDF.
What I have
Public Function myFunk(rng As Range) As Variant
Dim x As Integer
Dim Datarange As Variant
Dim Equation As String
Dim VariablesLength As Integer
Dim Variable As String
Datarange = rng.Value
'insert something around here to get the list "rng or Datarange" sorted
'maybe up or down a line of code depending on how its being done.
Equation = Datarange(1, 1)
For x = 2 To UBound(Datarange, 1)
VariablesLength = Len(Datarange(x, 1)) - 1
Variable = Left$(Datarange(x, 1), VariablesLength)
Equation = Replace$(Equation, Variable, Datarange(x, 2))
Next x
myFunk = rng.Worksheet.Evaluate(Equation)
End Function
Example Data
Any help with this would be much appreciated. In that last example I should point out that the "=" is not part of the sort. I have a routine that strips that off the end of the string.
So in order to achieve what I was looking for I added a SWAP procedure and changed my code to look like this.
Public Function MyFunk(rng As Range) As Variant
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim datarange As Variant
Dim Equation As String
Dim VariablesLength As Integer
Dim Variable As String
'convert the selected range into an array
datarange = rng.Value
'verify selected range is of right shape/size
If UBound(datarange, 1) < 3 Or UBound(datarange, 2) <> 2 Then
MyFunk = CVErr(xlErrNA)
Exit Function
End If
'strip the equal sign off the end if its there
For x = 2 To UBound(datarange, 1)
If Right$(datarange(x, 1), 1) = "=" Then
datarange(x, 1) = Left$(datarange(x, 1), Len(datarange(x, 1)) - 1)
End If
Next x
'sort the array so that a variable does not get substituted into another variable
'do a top down swap and repeat? Could have sorted by length apparently.
For x = 2 To UBound(datarange, 1) - 1
For y = x + 1 To UBound(datarange, 1)
If InStr(1, datarange(y, 1), datarange(x, 1)) <> 0 Then
For z = LBound(datarange, 2) To UBound(datarange, 2)
Call swap(datarange(y, z), datarange(x, z))
Next z
y = UBound(datarange, 1)
x = x - 1
End If
Next y
Next x
'Set the Equation
Equation = datarange(1, 1)
'Replace the variables in the equation with values
For x = 2 To UBound(datarange, 1)
Equation = Replace$(Equation, datarange(x, 1), datarange(x, 2))
Next x
'rest of function here
End Function
Public Sub swap(A As Variant, B As Variant)
Dim Temp As Variant
Temp = A
A = B
B = Temp
End Sub
I sorted by checking to see if text would substitute into other text in the list. Byron Wall made a good point that I could have sorted based on text length. Since I had completed this before I saw the suggestion it did not get implemented though I think it may have been a simpler approach.
I've been working on this for two days and thrashing around and here's where I am now.
Private Function SetColumns(sRptVer As String, iColumns() As Integer)
If sRptVer = "Q1" Then
iColumns(1) = 5 '<- Subscript out of range error here Hovering shows _
'"iColumns(1)=<Subscript out of range>"
iColumns(2) = 6
iColumns(3) = 7
iColumns(4) = 17
End If
If sRptVer = "Q2" Then
iColumns(1) = 5
iColumns(2) = 6
iColumns(3) = 7
iColumns(4) = 8
iColumns(5) = 9
iColumns(6) = 10
iColumns(7) = 17
End If
SetColumns = iColumns()
End Function
Private Sub Test2()
Dim iColValue() As Integer
Dim sRptVer As String
Dim iColumns() As Integer
sRptVer = "Q1"
iColValue() = SetColumns(sRptVer, iColumns())
For i = 1 To 10
Debug.Print iColValue(i)
Next i
End Sub
The goal is to be able to be able to pass a string designating the quarter and return an array that will serve to set the columns I will iterate over to get values out of an Excel spreadsheet. (I'm pulling data from Excel into Access).
I've tried starting with iColumns(0). No difference.
NOTE: Access vba does not like to set arrays like so iColumns()={1,2,3,4}. It balks at the "{}".
Access vba doesn't seem to like "ReDim" either, I get a compile error: Syntax error when I "redim icolumns() as Integer" in the SetColumns function.
Thanks in advance.
You don't need two separate arrays in your calling procedure to do what you want. Try this instead:
Private Function SetColumns(sRptVer As String) As Integer()
Dim iColumns() As Integer
Select Case sRptVer
Case "Q1"
ReDim iColumns(1 To 4)
iColumns(1) = 5
iColumns(2) = 6
iColumns(3) = 7
iColumns(4) = 17
Case "Q2"
ReDim iColumns(1 To 7)
iColumns(1) = 5
iColumns(2) = 6
iColumns(3) = 7
iColumns(4) = 8
iColumns(5) = 9
iColumns(6) = 10
iColumns(7) = 17
End Select
SetColumns = iColumns
End Function
Private Sub Test2()
Dim sRptVer As String
Dim iColValue() As Integer
sRptVer = "Q1"
iColValue() = SetColumns(sRptVer)
Dim i As Integer
For i = LBound(iColValue) To UBound(iColValue)
Debug.Print iColValue(i)
Next i
End Sub
I made a few other changes:
I used ReDim to dynamically size the array based on the parameter passed to SetColumns.
I passed both lower and upper bounds to the array in the ReDim statement. Arrays in VBA are zero-bound by default*, so ReDim iColumns(4) is actually equivalent to ReDim iColumns(0 To 4).
Because we no longer know the size of the array ahead of time, I use the LBound() and UBound() functions to walk the array.
I changed your two If statements to a Select...Case statement. Based on your limited sample code that you provided this seemed appropriate. If your actual code is more complex, it may not be.
*NOTE: Unfortunately, you can change the starting array base in VBA using the Option Base statement. Please don't do this. Ever. You will only confuse yourself and others. If you want a specific array to start from 1 then be explicit when you Dim or ReDim the array as I showed in my example.
I'm trying to teach myself some basic VBA in Excel 2010 and I've come across a problem I can't google myself out of. The objective is to create a button which when pressed, automatically does linest for me and writes the values into an array. So far, this is my code.
Private Sub CommandButton1_Click()
Dim linest As Variant
Dim linestArray(4,1) as Variant
Dim i As Integer, j as Integer
linest = Application.LinEst(Range("U49:U51"), Range("T49:T51"), True, True)
For i = 0 To 4
linestArray(i,0) = accessing values of linest variable fyrst column
Cells(68 + i, 21) = linestArray(i,0)
Next
For j = 0 To 4
linestArray(j,1) = accessing values of linest variable second column
Cells(68 + j, 22) = linestArray(j,0)
Next
End Sub
How do I access the values of variable linest so I can store them to an array and print them? Thank you.
EDIT: I figured it out. Variable linest is already an array! I feel pretty dumb. Sorry, this can be ignored.
New code:
Dim linestArray As Variant
linestArray = Application.LinEst(Range("U49:U51"), Range("T49:T51"), True, True)
For i = 0 To 4
For j = 0 To 1
Cells(68 + i, 21 + j) = linestArray(i + 1, j + 1)
Next
Next
The output of any such formula is a Variant array. So you've got that part right.
For a general approach to these Application. (use WorksheetFunction. instead, it's much faster) type functions is...
Type the function in Excel (as an array formula, Ctrl-Shift-Return, if need be)
The output is an N x M matrix of some sort (N =1 , M =1) for most cases
When you do Var = Application.Linest(xyx), the answer gets stored in Var
Get the size of the Var using Ubound(Var, 1), Ubound(Var, 2) to get number of rows and columns (note that these are base 0 type arrays)
Usually, the size will be one x one. In that case, your variable is stored in Var(0,0) i.e. a zero base multidimensional variant array, the top left element.
Hope this helps.
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)"