I am trying to make a UDF in VBA that takes multiple arrays of equal size as an argument and then loops through them staying at the same index for each array.
I have set the code up as follows.
Public Function TwoArrays(TargetRange(), CriteriaRange())
dim value as range
for each value in TargetRange
next
end function
The issue is I can't get the index of the TargetRange to use in the CriteriaRange and even if I could for whatever reason whenever I put something like
CriteriaRange(2)
I get an error instead of what happens to be within that index.
Is there a way I can get the UDF to treat the array like a normal VBA array where I can do something along the lines of
Public Function TwoArrays(TargetRange(), CriteriaRange())
dim result as range
for i = lowerbound(TargetRange) to ubound(TargetRange)
If CriteriaRange(i) > 0 then
result = result + TargetRange(i)
end if
next i
end function
Thank you!
Like this:
Public Function TwoArrays(TargetRange As Range, CriteriaRange As Range)
Dim result, arrT, arrC, r As Long, c As Long
arrT = TargetRange.Value
arrC = CriteriaRange.Value
'probably should add some code here to check both ranges are the same size...
For r = 1 To UBound(arrT, 1)
For c = 1 To UBound(arrT, 2)
If arrC(r, c) > 0 Then result = result + arrT(r, c)
Next c
Next r
TwoArrays = result
End Function
Related
(Fair Warning, I am self taught on VBA so I apologize in advance for any cringe-worthy coding or notations.)
I have an estimating worksheet in excel. The worksheet will have a section for the user to input variables (which will be an array). The first input variable will "reset" the remaining input variables to a standard value when the first variable is changed. The standard values for the input variables are stored in a function in a module. I am attempting to fill the input variable array with the standard values from the function and then display those values on the sheet. I was easily able to do this without arrays but have had no luck in moving everything into arrays.
This is for excel 2010. I previously did not use arrays and created a new variable when needed, however the estimating sheet has grown much larger and it would be better to use arrays at this point. I have googled this question quite a bit, played around with removing and adding parenthesis, changing the type to Variant, trying to set the input variable array to be a variable that is an array (if that makes sense?), and briefly looked into ParamArray but that does not seem applicable here.
Dim BearingDim(1 To 9, 1 To 4, 1 To 8) As Range
Dim arrBearingGeneral(1 To 5, 1 To 8) As Range
Dim Test As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
'Set General Variable array to cells on the worksheet
For i = 1 To 5
For j = 1 To 8
Set arrBearingGeneral(i, j) = Cells(9 + i, 3 + j)
Next j
Next i
'Set Bearing Input Variables to Cells on the Worksheet
For p = 1 To 4
For i = 1 To 9
Select Case p
Case Is = 1
Set BearingDim(i, p, 1) = Cells(16 + i, 4)
Case Is = 2
Set BearingDim(i, p, 1) = Cells(27 + i, 4)
Case Is = 3
Set BearingDim(i, p, 1) = Cells(37 + i, 4)
Case Is = 4
Set BearingDim(i, p, 1) = Cells(49 + i, 4)
End Select
Next i
Next p
'Autopopulate standard input variables based on Bearing Type
inputMD_StdRocker BearingType:=arrBearingGeneral(1, 1), _
arrBearingDim:=BearingDim
End Sub
Sub inputMD_StdRocker(ByVal BearingType As String, ByRef _
arrBearingDim() As Variant)
Dim arrBearingDim(1 To 9, 1 To 4)
Select Case BearingType
Case Is = "MF50-I"
For j = 1 To 2
arrBearingDim(2, j) = 20
arrBearingDim(3, j) = 9
arrBearingDim(4, j) = 1.75
Next j
arrBearingDim(5, 1) = 15
'There are numerous more select case, but those were removed to keep it
'short
End Select
End Sub
The expected output is my "BearingDim" Array will have certain array index values set to a standard value from the "inputMD_StdRocker" function. Then those values will be displayed in the cell that corresponds to the array index.
Currently, I get a compile error "Type Mismatch, Array or User-Defined Type Expected". I have been able to get around the type mismatch by removing the () from "arrBearingDim()" in the function title for "inputMD_StdRocker" however, it will not pass the values back to my "BearingDim" array.
Any help would be greatly appreciated.
This is a partial answer to what (I think) is a misunderstanding you have of how to use arrays. There are a few problems in your code.
First, you're defining a two-dimensional and a three-dimensional array of Ranges when I believe you really only want to store the values captured from the worksheet. (If I'm wrong, then you are never initializing the array of Ranges, so none of the ranges in the array actually point to anything.)
Secondly, it looks as if your initial array arrBearingGeneral is always filled from the same (static) area of the worksheet. If this is so (and you really do want the values from the cells, not an array of Range objects), then you can create a memory-based array (read this website, especially section 19). So the first part of your code can be reduced to
'--- create and populate a memory-based array
Dim bearingDataArea As Range
Dim arrBearingGeneral(1 To 5, 1 To 8) As Variant
Set bearingDataArea = ThisWorkbook.Sheets("Sheet1").Range("D10:K14")
arrBearingGeneral = bearingDataArea.Value
Optionally of course you can calculate the range of your data instead of hard-coding it ("D10:K14"), but this example follows your own example.
While this isn't a complete answer, hopefully it clears up an issue to get you farther down the road.
This is a tricky one for me to explain, so I'll start with the code I have so far, and later with what I am trying to achieve.
Current Code
Option Explicit
Public eSigTickerArr As Variant
' Public type to save array
Type Watchlist
eSigTicker As String
Op As Double
Hi As Double
Lo As Double
Cl As Double
Vol As Double
BarTime As Variant
End Type
Public WatchlistArr() As Watchlist ' save an array of special type "Watchlist"
'====================================================================
Sub Mainr()
ReDim WatchlistArr(0) ' init array size
eSigTickerArr = Array("Part1", "Part2", "Part3")
For Each eSigTickerElem In eSigTickerArr
' check if first member of array is occupied
If WatchlistArr(0).eSigTicker <> "" Then ' not first time running this code >> increase array size by 1
ReDim Preserve WatchlistArr(UBound(WatchlistArr) + 1) ' increase array size by 1
End If
' ... Some Code, working fine ....
' populate array Type with data (also works)
With WatchlistArr(UBound(WatchlistArr))
.eSigTicker = eSigTickerElem
.Op = LastCSVLine(2)
.Hi = LastCSVLine(3)
.Lo = LastCSVLine(4)
.Cl = LastCSVLine(5)
.Vol = LastCSVLine(6)
.BarTime = LastCSVLine(1)
End With
Next eSigTickerElem
' ******* calculate the average of only "Hi" ******
Dim myAvg
myAvg = WorksheetFunction.Average(WatchlistArr.Hi) '<--- Getting an Error !
End Sub
I'm getting an error at the line above.
My Challenge: I want to get the average only of a certain variable of my type array WatchlistArr, and I don't want to use a loop, as there can be 10,000 records (or more).
Is there any way to get the value with the Average function ?
Should I switch to 2-D array ? or Maybe 3-D array ?
myAvg = WorksheetFunction.Average(WatchlistArr.Hi) '<--- Getting an Error !
Yep. What this code means to do is similar to this:
myAvg = watchListArr.Select(item => item.Hi).Average();
Where item => item.Hi is a selector function that is invoked for every item in watchListArr. The only problem is that this is LINQ / C#, not VBA. VBA doesn't support delegates and other funky stuff even C# couldn't dream to do in v1.0.
But VBA has control flow structures that let you perform an action for every item in an array: use a For loop!
Dim i As Long, total As Double, count As Long
For i = LBound(watchListArr) To UBound(watchListArr)
total = total + watchListArr(i).Hi
If watchListArr(i).Hi <> 0 Then count = count + 1 'assuming zeroes are excluded
Next i
If count <> 0 Then myAvg = total / count
If you want to use Application.WorksheetFunction.Average, you'll need to copy the Hi member of every item in your array into its own array, and give it that array - and that will require... a loop... which is wasted cycles if that loop isn't also computing the average as it goes.
As long as you're not using a For Each loop to iterate the array, you'll do fine. Iterating a 30K items array with a For loop is pretty much instant, no worries there.
You could define WatchlistArr as a 2-D array and then try this logic:
Dim myArray As Variant
myArray = Application.WorksheetFunction.Index(WatchlistArr, 0, 2)
This will return column 2 as as array, which can be passed into the Average method:
myAvg = WorksheetFunction.Average(myArray)
I am trying to distinguish between no input or "Null" and the input of something including the number 0.
I wrote a public function called "ZeroToAppear" that works well enough when used with Index Match Functions by returning the number 0 as a string, but it will not work along with a sum function which is common in financial budgets:
Public Function ZeroToAppear(x As Variant) As Variant
If IsNull(x) Then
ZeroToAppear = Null
ElseIf x = 0 Then
ZeroToAppear = CStr(x)
Else
ZeroToAppear = x
End If
End Function
I have rationalized that the problem is that excel automatically considers null as a 0 in order to avoid ArgumentNullExceptions.
So I am trying to write another Macro that will work when taking the sum of a range that can distinguish between no input and 0 or greater input since the sum of cells with no input automatically equals zero in excel and I would like it to report null or even better report false in order to not do the sum at all.
I have started writing a function that tests each cell in the range that I would be summing to see whether it is null, error, or something. If it is null or error, I want it to report null into a test array. If there is some other input I want it to report whatever that input is into the test array. Then I want to identify if the entire test array is reporting null to make my original function false & not run the sum in the range that I am testing but if there are other values then the function should return true and the sum can be run.
Public Function NullOrErrorFalse() As Variant
Dim arrOutput() As Variant
ReDim arrOutput(n) As Variant
n = 0
For Each cell In NullOrErrorFalse()
If IsNull(cell) Then
arrOutput(n) = Null
ElseIf IsError(cell) Then
arrOutput(n) = Null
Else
arrOutput(n) = cell.Value
End If
n = n + 1
Next cell
Sub test(arrOutput())
If arrOutput() = Null Then
NullOrErrorFalse = False
Else
NullOrErrorFalse = True
End If
End Sub
End Function
At this point my function won't compile correctly and being new to VBA and programming in general, I am not sure if my issue is misuse or syntax or order of operations.
Yep, there is programming flaw due to misunderstanding VBA syntax.
Public Function NullOrErrorFalse() As Variant
Dim arrOutput() As Variant
....
For Each cell In NullOrErrorFalse()
NullOrErrorFalse is the name of the function, not the parameter you are examining. When changing it, you are actually changing the result. On the other hand, you need to provide your function with the parameter (range) that it will check.
You can do you custom sum as a User-Defined Function (UDF) in this way:
Public Function SumOrNull(r As Range) As Variant
SumOrNull = 0
For Each cel In r
If IsError(cel) Or cel = "" Or Not IsNumeric(cel.Value) Then
SumOrNull = CVErr(xlErrValue)
Exit Function
End If
SumOrNull = SumOrNull + cel.Value
Next
End Function
The idea is that as soon as there is any pattern that you dont want, your UDF raises an error, so that Excel displays #Value, and the cell using your UDF is considered as erroneous.
I am fairly new to excel vba and I can't seem to fix this problem with vbArrays. I created the function cumsum in vba just to make my life easier. However, I want to make the code flexible such that I can pass in both variants from a function and also a range. In my code, when I added the line vec=vec.value if I am passing in a range, it works perfectly fine but it doesn't work if I want it to work if I call the function and pass in a non range type. What I noticed was if I didn't have the line vec=vec.value in my code and I pass in a range, it has dimension 0 and I checked by writing my own function. Can someone please explain to me how I can fix this problem? Thanks.
Public Function cumsum(vec As Variant) As Variant
Dim temp() As Variant
MsgBox (getDimension(vec))
'works if i use vec=vec.value if vec is a range but has 0 if i do not vec = vec.values
ReDim temp(LBound(vec, 1) To UBound(vec, 1), 1 To 1) As Variant
Dim intCounter As Integer
For intCounter = LBound(vec) To UBound(vec)
If intCounter = LBound(vec) Then
temp(intCounter, 1) = vec(intCounter, 1)
Else
temp(intCounter, 1) = temp(intCounter - 1, 1) + vec(intCounter, 1)
End If
Next
cumsum = temp()
End Function
Function getDimension(var As Variant) As Integer
On Error GoTo Err:
Dim i As Integer
Dim tmp As Integer
i = 0
Do While True:
i = i + 1
tmp = UBound(var, i)
Loop
Err:
getDimension = i - 1
End Function
Why don't you just check the data type of vec by using VarType and TypeName then perform the necessary manipulation on vec
Public Function cumsum2(vec As Variant) As Variant
MsgBox TypeName(vec)
MsgBox VarType(vec)
cumsum2 = 0
End Function
The answers from #Jake and #chris are hints in the right direction, but I don't think they go far enough.
If you are absolutely sure that you'll only ever call this routine as a UDF (i.e. from formulas in your worksheets), then all you really need to do is add this:
If IsObject(vec) Then
Debug.Assert TypeOf vec Is Range
vec = vec.Value2
End If
to the start of your function. Called as a UDF, the only object type it should ever get passed is Range. Also, called as a UDF, you can rely on the fact that any arrays it gets passed will be indexed starting from 1.
I could pick out other problems with your routine, but they would be beside the point of your original question. Briefly: this will only work on column vectors, it will fail for single-cell ranges, etc.
Note that the reason your getDimension function is returning zero for Ranges because UBound is choking on the range. Your error handler happily catches an error (type mismatch) you didn't really expect to get and returning zero. (That method of finding "dimension" is assuming the error will be a subscript out range error.)
I wrote an answer a while back describing why, when working with Excel, I don't think the general getDimension approach is a good one:
https://stackoverflow.com/a/6904433/58845
Finally, the issue with VarType is that, when passed an object that has a default property, it will actually return the type of the property. So VarType(<range>) is going to tell you the type of the stuff in the range, not the code for object, because Range has a default property, Range.Value.
Modify your getDimension to include
If TypeName(var) = "Range" Then
var = var.Value
End If
This is a continuation of the question excel different SUM.IF array function, But since I've marked that as solved, I created a new question.
What I wanted there was a distinct sum of some values, and I have implemented #Marc's solution. However the report requirements have changed. I now need to exclude all values that are hidden, but still keep the original calculation method. Basicly i want to add a feature in the same way a SUBTOTAL(109, ref) would work.
To this I've created a simple VBA function CellIsNotHidden(Range), which returns 0 or 1 depending on the cell.
Therefore my best guess would be a formula like: {=SUM(IF($B1:$B7<>$B2:$B8,D2:D8,0)*CellIsNotHidden(D2:D8))}
But this function doesn't work, because CellIsNotHidden is not an array function.
How can I solve this?
In advance, thanks
Gunnar
Edit:
Thought I should include the simple VBA function:
Function CellIsNotHidden(InputRange As Range)
If InputRange.Cells.Height = 0 Then
CellIsNotHidden = 0
Else
If InputRange.Cells.Width = 0 Then
CellIsNotHidden = 0
Else
CellIsNotHidden = 1
End If
End If
End Function
Try this for UDF CellIsNotHidden. This will handle 1d (vector) and 2d arrays. Tested:
Function CellIsNotHidden(MyRange As Range) As Variant
Dim RootCell As Range
Dim tmpResult() As Long
Dim i As Long
Dim j As Long
On Error GoTo Whoops
ReDim tmpResult(0 To MyRange.Rows.Count - 1, 0 To MyRange.Columns.Count - 1)
Set RootCell = MyRange.Cells(1, 1)
For j = 0 To MyRange.Columns.Count - 1
For i = 0 To MyRange.Rows.Count - 1
tmpResult(i, j) = Not (RootCell.Offset(i, j).EntireColumn.hidden Or RootCell.Offset(i, j).EntireRow.hidden)
Next i
Next j
CellIsNotHidden = tmpResult
On Error GoTo 0
Exit Function
Whoops:
Debug.Print Err & " " & Error
End Function
Instead of using the UDF CellIsNotHidden(D2:D8) you could also try either of these:
SUBTOTAL(109,OFFSET(D2,ROW(D2:D8)-ROW(D2),))
SUBTOTAL(109,OFFSET(D2:D8,ROW(D2:D8)-MIN(ROW(D2:D8)),,1))