I'm trying to make a function MonstersInLevel() that filters the second column of my "LevelMonsters" named range based on the value of the first column. The range's first column represents a game level ID and the second column represents a monster ID that appears in that level. Here's what my range looks like.
If I call MonstersInLevel(2) I expect the function to return a range consisting of "2", "3" and "4".
Function MonstersInLevel(level As Integer) As Range
MonstersInLevel = Application.WorksheetFunction.Filter(Range("LevelMonsters").Columns(2), Range("LevelMonsters").Columns(1) = level)
End Function
I get:
A value used in the formula is of the wrong data type
I'm using the FILTER function as I would as an Excel formula. I assume there's some difference in the Excel and VBA syntax for FILTER's criteria.
Just encountered this problem myself and wanted to post my workaround.
We need to return an array of True/False to the worksheet function. To do this I created a Function that takes a 2D array, the column wanted and the value to compare. It then returns a 2d single column array of the necessary True/False.
Function myeval(arr() As Variant, clm As Long, vl As Variant) As Variant()
Dim temp() As Variant
ReDim temp(1 To UBound(arr, 1), 1 To 1)
Dim i As Long
For i = 1 To UBound(arr, 1)
temp(i, 1) = arr(i, clm) = vl
Next i
myeval = temp
End Function
So in this particular case it would be called:
Function MonstersInLevel(level As Integer) As Variant
MonstersInLevel = Application.WorksheetFunction.Filter(Range("LevelMonsters").Columns(2), myeval(Range("LevelMonsters").Value, 1, level),"""")
End Function
Avoid type mismatch in Worksheetfunction via VBA
Keeping in mind that the 2nd argument reflects a dynamic matrix condition
based entirely on ►worksheet logic (returning an array of 0 or 1 cell values /False or True])
it seems that you have
to execute an evaluation at least within this argument and
declare the function type (explicitly or implicitly) as Variant
Function MonstersInLevel(level As Integer) As Variant
'' Failing assignment:
' MonstersInLevel = Application.WorksheetFunction.Filter(Range("LevelMonsters").Columns(2), _
' Range("LevelMonsters").Columns(1) = level _
' )
MonstersInLevel = Application.WorksheetFunction.Filter( _
Range("LevelMonsters").Columns(2), _
Evaluate(Range("LevelMonsters").Columns(1).Address & "=" & level) _
)
End Function
...or to evaluate the complete function
Function MonstersInLevel(level As Integer) As Variant
Dim expr As String
expr = "=Filter(" & _
Range("LevelMonsters").Columns(2).Address & "," & _
Range("LevelMonsters").Columns(1).Address & "=" & level & _
")"
'Debug.Print expr
MonstersInLevel = Evaluate(expr)
End Function
Example call writing results to any target
Dim v
v = MonstersInLevel(2)
Sheet1.Range("D2").Resize(UBound(v), UBound(v, 2)) = v
Of course it would be possible as well to write .Formula2 expressions programmatically, even splitting into spill range references.
Addendum ........... //as of Jan 10th
Backwards compatible workaround via VBA.Filter()
"If you guys know any other VBA function that would be more appropriate
than Application.WorksheetFunction.Filter I'd be ok."
In order to provide also a backwards compatible alternative,
I demonstrate the following approach using the classic (VBA.)Filter() function (see section [3]) based upon
prior matching results (see [1]).
Note that Application.Match() comparing two (!) array inputs
delivers a whole array of possible findings (instead of a single result as most frequently executed).
Non findings are identified by IsError() values of -1; adding +1 results in a set
of zeros and ones. Section [2] enters corresponding data for positive findings.
Eventually non-findings (i.e. 0or zero) are removed by a tricky negative filtering.
Function getLevels()
Function getLevels(rng As Range, ByVal level As Long)
'Site: https://stackoverflow.com/questions/65630126/how-to-remove-only-the-duplicate-row-instead-of-removing-all-the-rows-that-follo
'[0] get datafield array
Dim v, v2
v = Application.Index(rng.Value2, 0, 1) ' 1st column
v2 = Application.Index(rng.Value2, 0, 2) ' 2nd column
'[1] check data (with Match comparing 2 arrays :-)
Dim results
results = Application.Transpose(Application.Match(v, Array(level), 0))
'[2] rebuild with False/True entries
Dim i As Long
For i = 1 To UBound(results)
results(i) = IsError(results(i)) + 1 ' 0 or 1-values
If results(i) Then results(i) = v2(i, 1) ' get current value if true
Next i
'[3] remove zeros (negative filtering)
results = Filter(results, "0", False)
'[4] return results as vertical 1-based array
getLevels = Application.Transpose(results)
End Function
Example call
Const LVL = 2 ' define level
With Sheet1 ' change to project's sheet Code(Name)
'define data range (assuming columns A:B)
Dim rng As Range
Set rng = .UsedRange.Resize(, 2)
'function call getLevels()
Dim levels
levels = getLevels(rng, level:=LVL)
'write to target
.Columns("I:I").Clear
.Range("I2").Resize(UBound(levels), 1) = levels
End With
Solution without any supporting VBA function:
Function MonstersInLevel(level As Integer) As Variant
With Application.WorksheetFunction
MonstersInLevel = .Filter(Range("LevelMonsters").Columns(2), _
.IfError(.XLookup(Range("LevelMonsters").Columns(1), level, True), False))
End With
End Function
XLookup returns an array of #N/A or True. IfError replaces errors with False. Finally, the Filter function receives an array of booleans as the second parameter.
EDIT
Removed the IfError function thanks to #ScottCraner:
Function MonstersInLevel(level As Integer) As Variant
With Application.WorksheetFunction
MonstersInLevel = .Filter(Range("LevelMonsters").Columns(2), _
.XLookup(Range("LevelMonsters").Columns(1), level, True, False))
End With
End Function
I couldn't resolve your question but as I did some testing on the subject trying to do so, I thought I'd share my findings:
Based on this Microsoft community post, or at least the answers there, it seems you will need to loop through the output in one way or another...
That question seems to want to achieve the same as what you are wanting to do (I think?).
On the other hand, I have never used the WorksheetFunction.Filter method, and the closest I could get it to working was like so:
Here is my sample data - RangeOne is Column A and RangeTwo is Column B. I have used the =FILTER() function in cell C1 evaluating the input in D1 for reference of expected results. Naturally this function is working as expected! The VBA routine is outputting to Columns E, F and G.
Sub TestFilterFunction()
Dim TestArray As Variant
Range("E1:E3") = Application.Filter(Range("RangeTwo"), Range("RangeOne"), Range("D1"))
Range("F1:F3") = Application.Filter(Range("RangeTwo"), Range("RangeOne") = Range("D1")) 'Runtime Error 13
Range("G1:G3") = Application.Filter(Range("RangeTwo"), Range("RangeOne"))
TestArray = Application.Filter(Range("RangeTwo"), Range("RangeOne"), Range("D1"))
TestArray = Application.Filter(Range("RangeTwo"), Range("RangeOne") = Range("D1")) 'Runtime Error 13
TestArray = Application.Filter(Range("RangeTwo"), Range("RangeOne"))
Range("H1:H3") = Application.Filter(Range("RangeTwo", "RangeOne"), Range("RangeOne"), Range("D1"))
TestArray = Application.Filter(Range("A1:B9"), Range("RangeOne"), "2")
End Sub
Column E returned the first 3 values from RangeTwo.
Column F has not been populated - This is because that line threw the Runtime error 13 - Type Mismatch
Column G returned the first 3 values from RangeTwo.
Column H returned the first 3 values from "A1:B9" (both ranges together) - specifically the first 3 values of column A.
I thought this was odd so I threw in an array to assign the values to rather than directly to the worksheet;
The first TestArray line and the third TestArray line both populated the array with the entire RangeTwo values;
I realised with the syntax of the first and third attempt at the WorksheetFunction.Filter, the entire range is returned (that being the first argument - Arg1 - range), but when trying to include the = Range("D1") , it returns the Type Mismatch error.
The final TestArray attempt being the same syntax as the Column H test, returned both columns in a 2D array (now TestArray(1 To 9, 1 To 2)).
I should note I couldn't find any documentation at all on WorksheetFunction.Filter so I'm assuming it does follow the same syntax as the Excel Sheet Function has.
If I find anything more on this topic I'll come back and edit it in, but for now it's looking like perhaps a solution using either loops or Index/Match functions also will need to happen to have the data returned in VBA.
I thought about perhaps writing the sheet formula to a cell and then grab that into an array or something but Excel inserts # into it now which only returns a single cell result, i.e.
Range("J1").Formula = "=FILTER(B1:B9, A1:A9 = D1)"
Would return in J1:
=#FILTER(B1:B9, A1:A9 = D1)
Which with our sample data, would only return 2 in J1 as opposed to the expected/desired 2, 3 and 4 in J1:J3.
I can't work out a way to remove the # as it is applied when the function is written to the cell unfortunately, but hopefully any of the above helps someone find a solution.
Just some comments to help you out.
If you are using the new FILTER() function from either a worksheet cell or within some VBA code, the first argument should be a range and the second argument should a a Boolean array. (if you don't enter something that can evaluate to a Boolean array, VBA may complain the the data type is wrong)
You would be best served (in VBA) if you:
explicitly declared a 2 dimensional, column-compatible, Boolean array
filled the array
used the array in the function call
Here is a super simple example. Say we want to filter the data from A1 to A6 to remove blanks. We could pick a cell and enter:
=FILTER(A1:A6,A1:A6<>"")
Looks like:
Now we want to perform the same activities with a VBA sub and put the result in a block starting with B9. The code:
Sub SingleColumn()
Dim r As Range, wf As WorksheetFunction, i As Long
Dim arr, s As String, dq As String, boo, rc As Long
Set wf = Application.WorksheetFunction
Set r = Range("A1:A6")
rc = r.Rows.Count
ReDim boo(1 To r.Rows.Count, 1 To 1) As Boolean
i = 1
For Each rr In r
If rr.Value = "" Then
boo(i, 1) = False
Else
boo(i, 1) = True
End If
i = i + 1
Next rr
arr = wf.Filter(r, boo)
MsgBox LBound(arr, 1) & "-" & UBound(arr, 1) & vbCrLf & LBound(arr, 2) & "-" & UBound(arr, 2)
Range("B9").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub
Result:
On Excel version 15.0 (2013), I don't see Application.WorksheetFunction.Filter (tried with Show Hidden Members):
So maybe this is a newer function in later versions ?
My top Google search directs me to this question ;)
So, my answer is to avoid the function primarily from the point of view of backwards compatibility.
Alternate code options presented below returning e.g. a Range and a Variant.
Input:
Code:
Option Explicit
Sub Test()
Dim rngInput As Range
Dim rngFiltered As Range
Dim varFiltered As Variant
Dim varItem As Variant
Set rngInput = ThisWorkbook.Worksheets("Sheet1").Range("A2:B10")
' as range
Debug.Print "' Output as Range"
Set rngFiltered = MonstersInLevel_AsRange(rngInput, 2, 1, 2)
Debug.Print "' " & rngFiltered.Address ' expect B5, B6, B8
Debug.Print "' ---------------"
' as variant
Debug.Print "' Output as Variant"
varFiltered = MonstersInLevel_AsVariant(rngInput, 2, 1, 2)
For Each varItem In varFiltered
Debug.Print "' " & varItem ' expect 3, 4, 5
Next varItem
Debug.Print "' ---------------"
End Sub
Function MonstersInLevel_AsRange(rngToFilter As Range, _
ByVal lngLevel As Long, _
ByVal lngColIxToFilter As Long, _
ByVal lngColIxForValue As Long) As Range
Dim rngResult As Range
Dim lngRowIndex As Long
Dim lngResultIndex As Long
Set rngResult = Nothing
For lngRowIndex = 1 To rngToFilter.Rows.Count
If rngToFilter.Cells(lngRowIndex, lngColIxToFilter) = lngLevel Then
If rngResult Is Nothing Then
Set rngResult = rngToFilter.Cells(lngRowIndex, lngColIxForValue)
Else
Set rngResult = Union(rngResult, rngToFilter.Cells(lngRowIndex, lngColIxForValue))
End If
End If
Next lngRowIndex
Set MonstersInLevel_AsRange = rngResult
End Function
Function MonstersInLevel_AsVariant(rngToFilter As Range, _
ByVal lngLevel As Long, _
ByVal lngColIxToFilter As Long, _
ByVal lngColIxForValue As Long) As Variant
Dim varResult As Variant
Dim lngRowIndex As Long
Dim lngResultIndex As Long
lngResultIndex = 0
ReDim varResult(0)
For lngRowIndex = 1 To rngToFilter.Rows.Count
If rngToFilter.Cells(lngRowIndex, lngColIxToFilter) = lngLevel Then
lngResultIndex = lngResultIndex + 1
ReDim Preserve varResult(1 To lngResultIndex)
varResult(lngResultIndex) = rngToFilter.Cells(lngRowIndex, lngColIxForValue)
End If
Next lngRowIndex
MonstersInLevel_AsVariant = varResult
End Function
Test output:
' Output as Range
' $B$5:$B$6,$B$8
' ---------------
' Output as Variant
' 3
' 5
' 4
' ---------------
Based on Christian Buses answer (https://stackoverflow.com/a/65671334/16578424) I wrote a generic function to use the FILTER-function.
It returns a one-dimensional array with the filtered values.
Public Function getFILTERValuesFromRange(rgResult As Range, rgFilter As Range, varValue As Variant) As Variant
If rgResult.Columns.count > 1 Or rgFilter.Columns.count > 1 Then
Err.Raise vbObjectError + 512, , "Only ranges with one column are allowed."
ElseIf rgResult.Rows.count <> rgFilter.Rows.count Then
Err.Raise vbObjectError + 512, , "Both ranges have to be of the same size."
End If
Dim arr1 As Variant
With Application.WorksheetFunction
arr1 = .filter(rgResult, .XLookup(rgFilter, varValue, True, False))
End With
getFILTERValuesFromRange = getOneDimensionalArrayFromRangeArray(arr1)
End Function
Private Function getOneDimensionalArrayFromRangeArray(arr1 As Variant) As Variant
Dim arr2 As Variant
ReDim arr2(LBound(arr1, 1) To UBound(arr1, 1))
Dim i As Long
For i = 1 To UBound(arr1, 1)
arr2(i) = arr1(i, 1)
Next
getOneDimensionalArrayFromRangeArray = arr2
End Function
I´m trying to understand the arrays in VBA, but I´m struggling a little bit, particularly with these lines. I can´t understand why, when the range I´m referring to is one or two cells, I get a mismatch error type 13 with the UBound.
Dim var2 As Variant
sArray2() As String
Dim i As Long
Dim range2 As Range
lastrow = Workbooks(Umsatzdatenbank).Sheets("Filter").Range("P" & _
Rows.Count).End(xlUp).Row
Set range2 = Workbooks(Umsatzdatenbank).Sheets("Filter").Range("P3:P" & _
lastrow)
var2 = range2.Value
ReDim sArray2(1 To UBound(var2))
For i = 1 To (UBound(var2))
sArray2(i) = var2(i, 1)
Next
When you assign the value of a single cell to a variable, the variable will be a single value, not an array. That's how Excel/VBA works, you cannot change this.
You can check if your variable var2 (not the best name for a variable IMHO), is an array or not and react to it, for example like:
var2 = range2.Value
If IsArray(var2) Then
ReDim sArray2(1 To UBound(var2))
For i = 1 To (UBound(var2))
sArray2(i) = var2(i, 1)
Next
Else
ReDim sArray2(1 To 1)
sArray2(1) = var2
End If
I have 2 sheets. I am using a user-defined function in sheet 1, in which I want to use an array to compare some strings. The array is comprised of the contents of a column of cells in the second sheet (which is named "phrases.").
So (looking at it another way) in "phrases" I have 100 strings typed into column P, cells 3 to 102. And I want to put all of them into an array that i can use later.
Now, let me complicate it a little - my intent is that users of the spreadsheet will be able to add new content to column P, so that it may eventually be 500 cells or more. So I really want to populate that array dynamically.
Here's where i am - and it doesn't seem to be working:
Dim newarray() As String
Dim i As Long
Dim counter As Long
counter = 0
For i = 0 To 5000
If Worksheets("phrases").Cells(i + 3, 16).Value <> 0 Then
newarray(counter) = Worksheets("phrases").Range(i + 3, 16).Value
counter = counter + 1
End If
Next
Where am i going wrong?
Please note - I've tried this without .Value - didn't seem to work.
I've tried this with .Text instead of .Value - didn't seem to work.
I've tried CStr(Worksheets("phrases").Range(i + 3, 16).Value) and several variations - and it didn't seem to work.
I expect there is something simple I am missing here - but i have no idea what.
Dim newarray() As String
Dim i As Long
Dim lr AS Long
Dim counter As Long
lr = ActiveSheet.Range("P" & Rows.Count).End(xlUp).Row
counter = 0
For i = 1 To lr
If Worksheets("phrases").Range("P" & i).value <> 0 Then
Redim Preserve newarray(counter)
newarray(counter) = Worksheets("phrases").Range("P" & i).value
counter = counter + 1
End If
Next
First construct a comma-separated string. Then convert the string into an array using the Split() function.
You can make the array directly from the cells without having to loop at all using a single line of code, this will also capture anything that the user adds to the bottom of column P by using the Resize() method:
Sub SO()
stringArray = [P3:P102].Resize(Range("P" & Rows.Count).End(xlUp).Row - 2, 1)
'// Print each value in the array
For Each x In stringArray
Debug.Print CStr(x)
Next x
End Sub
I would like to be able to add some range of data in a dynamic multidimensional array without using a double loop that screens each element of the array. But I don't know if it is possible. By double loop, I mean such a code (this is only an example):
Dim Films(1 To 5, 1 To 2) As String
Dim i As Integer, j As Integer
For i = 1 To 5
For j = 1 To 2
Films(i, j) = Cells(i, j).Value
Next j
Next i
I am using VBA 2010. I know how many rows my array has, but the number of columns is variable.
Here is my code :
Sub DRS(Item)
'item is a name to search for in a specific range
Dim SrcRange() As Variant
Dim cell3 As Range
Dim n As Integer, m As Integer
SrcRange() = Array()
ReDim SrcRange(45, 0)
m = -1
n = 0
With Sheets("X")
For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)
'the range ("I13:AG...") contains names, and some will match with "item"
m = m + 1
If Len(cell3.Value) > 0 And cell3 = Item Then
SrcRange(0, n) = .Range(m + 8 & "30:" & m + 8 & "75")
'the previous line **should** add a whole range of cells (which contain numbers, one by cell) in a colum of the array, but this is the line that doesn't work.
n = n + 1
ReDim Preserve SrcRange(UBound(SrcRange), n)
End If
Next cell3
End With
End Sub
I already tried those::
SrcRange(:, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(0:45, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(, n) = .Range(m + 8 & "30:" & m + 8 & "75")
but no one worked.
Is there a way or a formula that would allow me to add a full range of cells to each column of the array, or am I obliged to use a double loop to add the elements one by one?
I'm guessing that this Range...
.Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)
...should actually be xlToLeft instead of xlToRight (xlToRight will always return I13:AG16384).
I'm also not entirely sure what the m + 8 & "30:" & m + 8 & "75" is supposed to be evaluating to, because you increment the variable m each time through the loop, and it gives you ranges like 930:975. I'll take a stab in the dark and assume that the m + 8 is supposed to be the column that you found the item in.
That said, the .Value property of a Range object will just give you a 2 dimensional array. There isn't really any reason to build an array - just build a range and then worry about getting the array out of it when you're done. To consolidate the range (you only get the first area if you grab its Value), just copy and paste it to a temporary Worksheet, grab the array, then delete the new sheet.
Sub DRS(Item)
'item is a name to search for in a specific range
Dim SrcRange() As Variant
Dim found As Range
Dim cell3 As Range
With Sheets("X")
For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToLeft).Column)
'the range ("I13:AG...") contains names, and some will match with "item"
If Len(cell3.Value) > 0 And cell3.Value = Item Then
If Not found Is Nothing Then
Set found = Union(.Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column)), found)
Else
Set found = .Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column))
End If
End If
Next cell3
End With
If Not found Is Nothing Then
Dim temp_sheet As Worksheet
Set temp_sheet = ActiveWorkbook.Sheets.Add
found.Copy
temp_sheet.Paste
SrcRange = temp_sheet.UsedRange.Value
Application.DisplayAlerts = False
temp_sheet.Delete
Application.DisplayAlerts = True
End If
End Sub
I've been trying to research this for a while now. I'm trying to write a function that will find the last populated row in column B (Starting at B9), and add the string values in column B into an array.
Any help would be much appreciated, thanks everyone.
Option Explicit
Function locationSum2(location) As Integer
Dim arrayLength As Integer
arrayLength = LastRowInColumn(2) - 9
Dim arrayPosition As Integer
Dim locationColumn() As String
ReDim locationColumn(0 To arrayLength) As String
Dim celltext As String
Dim i As Integer
For i = 0 To i = arrayLength
celltext = Cells((9 + i), 2).Text
locationColumn(i) = celltext
Next i
For arrayPosition = 0 To arrayPosition = UBound(locationColumn)
If location = locationColumn(arrayPosition) Then
locationSum2 = locationSum2 + Cells(arrayPosition + 9, 11).Value
End If
Next arrayPosition
locationSum2 = locationSum2
End Function
Following a comment, I also chopped the code way down to basically just a loop that check the argument against everything in column B instead of making an array.
Option Explicit
Function locationSum2(location) As Integer
Dim LastRow As Integer
LastRow = LastRowInColumn(2)
Dim i As Integer
For i = 9 To i = LastRow
If location = Cells(i, 2).Text Then
locationSum2 = locationSum2 + Cells(i, 11).Value
End If
Next i
locationSum2 = locationSum2
For whatever reason, it still doesn't seem to be reading Column B properly. It's returning a value of 0 so it doesn't seem to be finding a match.
You've setup the for loops incorrectly.
For i = 9 To i = LastRow
should be
For i = 9 To LastRow
I'm not sure if that is you're only problem, but lets start there