Related
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 am trying to learn to use variant data type but facing issues.
Public Function z_score(sections As Range, marks As Range) As Variant
Dim n As Integer
Dim score() As Variant 'marks range has a few empty cells and error cells as well
'hence using variant data type
n = UBound(sections.Value)
ReDim score(1 To n, 1 To 2)
score = marks.Value 'assigning marks range values to first column of score
For i = 1 To n 'adding second column with integer index for calling later
score(i, 2) = i
Next i
z_score = score
End Function
I am getting value error instead of nx2 matrix as output.
Can you please help how to resolve the error.
Any help is much appreciated, thanks..
There are a few areas that could cause this code to fail, I'm afraid:
If the passed in range is only 1 cell, the assignment to an array will throw an error.
VBA doesn't have a method for copying or cloning arrays, so your code score = marks.Value isn't doing what your comments are saying,
The sections parameter doesn't appear to be doing anything. You are sizing the array against it, but then iterating the marks array to assign values.
I'm not sure what you want to do with the function, but if it is a UDF called from a worksheet, it would need to be a formula array.
You could adjust your code as follows to have something a little more robust:
Public Function z_score(marks As Range) As Variant
Dim scoreArray() As Variant, marksArray() As Variant
Dim i As Long
marksArray = RangeValueToArray(marks)
ReDim scoreArray(1 To UBound(marksArray, 1), 1 To 2)
For i = 1 To UBound(marksArray, 1)
scoreArray(i, 1) = i
scoreArray(i, 2) = marksArray(i, 1)
Next
z_score = scoreArray
End Function
Private Function RangeValueToArray(rng As Range) As Variant
Dim v() As Variant
If rng.Cells.Count = 1 Then
ReDim v(1 To 1, 1 To 1)
v(1, 1) = rng.Value2
RangeValueToArray = v
Exit Function
End If
v = rng.Value2
RangeValueToArray = v
End Function
I think I figured out the problem. Assigning values of range to array works but makes the assigned array two dimensional array but with only 1 column if given range has only one column or row! So moving the redim with preserve to after assignment line worked for my purpose.
But if one wants to assign values to a column other than first in a 2D array (albeit with 1 column), only solution I am aware of at this point is to do iteration the way Ambie suggested.
Public Function z_score(sections As Range, marks As Range) As Variant
Dim score() As Variant 'marks range has a few empty cells and error cells as well
'hence using variant data type
Dim n As Integer
n = UBound(sections.Value)
score = marks.Value 'assigning marks range values to first column of score
ReDim Preserve score(1 To n, 1 To 2)
For i = 1 To n 'adding second column with integer index for calling later
score(i, 2) = i
Next i
z_score = score
End Function
Is it possible to create multi dimensional array with different element types (string and integer)?
I tried like this but wan't work
BT = Range("A12")
ReDim IT(BT) As String
ReDim RBT(BT) As Integer
ReDim IT_RBT(IT, RBT) as ???? how to create multi dim array with different variables type
Range("B2").Select
i = 0
Do
i = i + 1
IT(i) = ActiveCell
RBT(i) = i
IT_RBT(i, i) = ???? how to enter values in such array ????
ActiveCell.Offset(1, 0).Select
Loop While ActiveCell <> ""
Thank you
Use a Variant array.
Dim values() As Variant
Now, your code is making assumptions that should be removed.
BT = Range("A12") '<~ implicit: ActiveSheet.Range("A12").Value
If you mean to pull the value of A12 from a particular specific worksheet, then you should qualify that Range member call with a proper Worksheet object. See CodeName: Sheet1 for more info, but long story short if that sheet is in ThisWorkbook you can do this:
BT = Sheet1.Range("A12").Value
And now assumptions are gone. Right? Wrong. BT isn't declared (at least not here). If it's declared and it's not a Variant, then there's a potential type mismatch error with that assignment. In fact, the only data type that can accept any cell value, is Variant:
Dim BT As Variant
BT = Sheet1.Range("A12").Value
Here, we're assuming BT is a numeric value:
ReDim IT(BT) As String
That's another assumption. We don't know that BT is numeric. We don't even know that it's a value that can be coerced into a numeric data type: we should bail out if that's not the case:
If Not IsNumeric(BT) Then
MsgBox "Cell A12 contains a non-numeric value; please fix & try again."
Exit Sub
End If
ReDim IT(BT) As String
Now that will work... but then, only the upper bound is explicit; is this a 0-based or a 1-based array? If the module says Option Base 1, then it's 1-based. Otherwise, it's 0-based - implicit array lower bounds are an easy source of "off-by-one" bugs (like how you're populating the arrays starting at index 1, leaving index 0 empty). Always make array bounds explicit:
ReDim IT(1 To BT) As String
Unclear why you need 3 arrays at all, and why you're only populating (i,i) in the 3rd one - you cannot populate a 2D array with a Do...Loop structure; you need every value of y for each value of x, and unless you hard-code the width of the array, that's a nested loop.
Moreover, looping on the ActiveCell and Selecting an Offset is making the code 1) very hard to follow, and 2) incredibly inefficient.
Consider:
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Sheet1.Rows).End(xlUp).Row
ReDim values(1 To lastRow, 1 To 2) As Variant
Dim currentRow As Long
For currentRow = 2 To lastRow
Dim currentColumn As Long
For currentColumn = 1 To 2
values(currentRow, currentColumn) = Sheet1.Cells(currentRow, currentColumn).Value
Next
Next
Now, if we don't need any kind of logic in that loop and all we want is to grab a 2D variant array that contains every cell in B2:B???, then we don't need any loops:
Dim values As Variant
values = Sheet1.Range("A2:B" & lastRow).Value
And done: values is a 1-based (because it came from a Range), 2D variant array that contains the values of every cell in A2:B{lastRow}.
Note, code that consumes this array will need to avoid assumptions about the data types in it.
As #SJR has said, variant will allow for this. The below example is a easy example how to add different types to an array. Instead of x or y you can have a cell on a worksheet.
Dim array1() As Variant, i As Long
Dim x As String, y As Long
x = "5"
y = 1
For i = 1 To 10
ReDim Preserve array1(1 To 2, 1 To i)
array1(1, i) = x
array1(2, i) = y
y = y + 1
Debug.Print array1(1, i) & "," & array1(2, i) ' This is where you insert output
Next
You can do this:
BT = Range("A12")
ReDim IT(BT) As String
ReDim RBT(BT) As Integer
Dim IT_RBT(1 to 2) 'variant
IT_RBT(1) = IT 'add String array
IT_RBT(2) = RBT 'add Integer array
... this will keep your typed arrays functional but it's not a 2D array and you'd need to use notation like
IT_RBT(1)(1) 'String type
IT_RBT(2)(1) 'Integer type
I am trying to create a function that can take in both a range or an array to perform some further calculations. When an array passes, the function worked fine, but when the function is used on range in the worksheet, it gives me the VALUE! error.
My code looks like:
Function COMRET(data as variant, N as integer)
Dim nrows as long
If IsArray(data) Then
N = UBound(data,1)
Else
N = data.rows.count
End If
'... some other calculations here
End Function
The problem seems to come from the identification of an array above... other parts of the code seems OK when I comment out the IF section above. Not sure what I am doing wrong here. Appreciate the help. Thanks!
You are correct to declare data as Variant.
When you pass a range into that, it will be correctly passed as Variant/Object/Range, but then things will get a little bit more complicated.
When you call IsArray, which is a mere function, it will try to use the default property of the passed Range object, which is Value. IsArray(Range.Value) is True provided that the Range consist of more than one cell. But when you then call UBound, which is a very special function because it is highlighted as a keyword, it will not try to fetch data.Value and will operate on data directly, and data is a single Range object, so it cannot have an upper bound (while its .Value can).
You need to properly detect what you are being passed:
Public Function COMRET(data As Variant, N As Integer)
Dim nrows As Long
If TypeOf data Is Range Then
N = data.Rows.Count
ElseIf IsArray(data) Then
N = UBound(data, 1)
Else
' ???
End If
End Function
You're passing data as a Variant, which will cause IsArray(data) to always come out as true, regardless of whether you pass a range or array to it when calling the function.
Adding a third compulsory argument would work too, indicating the data type of the data variable:
Function COMRET(data As Variant, Is_Array As Boolean, N As Integer)
Dim nrows As Long
If Is_Array = True Then
N = UBound(data, 1)
Else
N = data.Rows.Count
End If
'... some other calculations here
End Function
Alternatively, you could add a check that uses the error thrown by attempting to use UBound on a range. This clears the need of a third argument:
Function COMRET(data As Variant, N As Integer)
Dim nrows As Long
On Error Resume Next
N = UBound(data, 1)
If Err.Number <> 0 Then N = data.Rows.Count
Err.Clear
On Error GoTo 0
'... some other calculations here
End Function
VarType() should be your friend:
' Const vbArray = 8192 (&H2000)
' Const vbString = 8
Debug.Print VarType(data) ' = vbArray (8192) Or vbString (8) = 8200
' Is data an array of sorts?
Debug.Print CBool((VarType(data) And vbArray) = vbArray)
From MSDN help:
The VarType function never returns the value for vbArray by itself. It
is always added to some other value to indicate an array of a
particular type. The constant vbVariant is only returned in
conjunction with vbArray to indicate that the argument to the VarType
function is an array of type Variant. For example, the value returned
for an array of integers is calculated as vbInteger + vbArray, or
8194. If an object has a default property, VarType (object) returns the type of the object's default property.
Module Module1
Sub main()
Dim pl(), pll() As Integer
Dim a, b As Integer
ReDim pl(0)
ReDim pll(0)
Do
a = InputBox("insert number:")
If a <> 0 Then
b = b + 1
ReDim Preserve pl(b)
pl(b) = a
End If
Loop Until a = 0
pll = **se(pl)**
End Sub
Function se(pol()) As Integer()
Dim r, t, w, m As Integer
Dim fix() As Integer
ReDim fix(0)
r = UBound(pol)
w = 2
For t = 1 To r
For m = 1 To r
If w <= r Then
If pol(w) < pol(t) Then
ReDim Preserve fix(t)
fix(t) = pol(w)
End If
End If
w = w + 1
Next
Next
se = fix
End Function
End Module
Hi, i created this function(dont know if its working) se(pl) that take array of numbers and return that array but in ascending order. But when I want assign that function into array - pll=se(pl) it gives me this error ==> "value of type integer cannot be converted to object because integer in not reference type"
Im sorry im noob, Can anybody help?
I adjusted your code to make it work. Yet, I tried to stick as much as possible to the original code to make it easier for you to learn from this solution:
Option Base 0
Option Explicit
Sub main()
Dim pl() As Integer
Dim a As Integer, b As Integer
ReDim pl(0)
Do
a = InputBox("insert number:")
If IsNumeric(a) And a <> 0 Then
b = b + 1
ReDim Preserve pl(b)
pl(b) = a
End If
Loop Until a = vbNullString
Debug.Print "Unsorted:"
For a = LBound(pl) To UBound(pl)
Debug.Print pl(a)
Next a
se intArray:=pl
Debug.Print "Sorted:"
For a = LBound(pl) To UBound(pl)
Debug.Print pl(a)
Next a
End Sub
Function se(ByRef intArray() As Integer)
Dim t As Integer, w As Integer, m As Integer
For t = LBound(intArray) To UBound(intArray)
For m = LBound(intArray) To UBound(intArray)
If intArray(t) < intArray(m) Then
w = intArray(t)
intArray(t) = intArray(m)
intArray(m) = w
End If
Next m
Next t
End Function
Some important notes:
(1) If you want to Dim multiple variables in one row then you'll have to repeat the DataType for each variable. So, it is Dim a as Integer, b as Integer and not Dim a, b as Integer. In the latter of the two cases a will be of DataType variant (and not as possibly expected Integer).
(2) To pass arrays in VBA from a procedure to a function you'll have to pass it ByRef. As such, there is no need to created a second or third array (such as pll() or fix()).
(3) There is a VBA command Fix. Hence, you cannot use it for a variable.
Let me know if the above helped or if you require more background or a slight adjustment.
you're tagging both "VBA" and "Visual Studio" but what follows is for VBA only
as to your very code I made it work (meaning it run to the end with no errors) only by substituting fix with fixed, since my Excel VBA "complier" throws a "Syntax error" message due to the existence of the "FIX()" VBA function.
so, after that substitution Function se was called and it returned an integer array with no problems.
but it didn't do what you stated as its due i.e.: "return the passed array in ascending order".
also, both your variable declaration and your input procedure would allow for strings to be passed.
so here follow my proposal to have your code do what you said you need ("return the passed array in ascending order") with a more robust input procedure
Option Explicit
Sub main()
Dim pl() As Integer, pll() As Integer
pl = TryConvertToInt(Split(InputBox("insert numbers (separated by space):")))
pll = se(pl)
End Sub
Function TryConvertToInt(arr As Variant) As Integer()
Dim i As Long, n As Long
ReDim myint(1 To UBound(arr) - LBound(arr) + 1) As Integer
For i = LBound(arr) To UBound(arr)
If IsNumeric(arr(i)) And arr(i) <> 0 Then
n = n + 1
myint(n) = CInt(arr(i))
End If
Next i
ReDim Preserve myint(1 To n) As Integer
TryConvertToInt = myint
End Function
Function se(pol() As Integer) As Integer()
'adapted from https://support.microsoft.com/en-us/kb/133135
Dim Temp As Integer
Dim i As Integer
Dim NoExchanges As Boolean
Dim fixed() As Integer
ReDim fixed(1 To UBound(pol) - LBound(pol) + 1)
fixed = pol
' Loop until no more "exchanges" are made.
Do
NoExchanges = True
' Loop through each element in the array.
' For i = 1 To UBound(pol) - 1
For i = LBound(fixed) To UBound(fixed) - 1
' If the element is greater than the element following it, exchange the two elements.
If fixed(i) > fixed(i + 1) Then
NoExchanges = False
Temp = fixed(i)
fixed(i) = fixed(i + 1)
fixed(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)
se = fixed
End Function
as you can see:
the main sub is now very simple and reduced to three statements
the first being the variables declarations one
the second statements nests three calls:
the call to InpuBox function where the user is asked to input all wanted numbers separated by spaces (and no need to have a zero to close the sequence)
the call to Split function to have it parse the input string into a strings array made of as many strings as input ones separated by spaces
the call to TryConvertToInt function that takes care of analyzing the strings array and convert it to an integer array, allowing only numbers other than zeros
the third statement calls se function and puts its return integer array into pll integer array
the se function has a sorting algorithm derived from https://support.microsoft.com/en-us/kb/133135, only adapted to handle integer arrays only.
with such a structure you can now be more effective in coding along since you can concentrate on the main sub to do "main" works (do this, do that, ...) via calls to specific subs and/or functions.
this leaving "non-main" works into specific subs or functions where to concentrate on for specific purpose only: for instance you may want to customize the TryConvertToInt function for more detailed filtering actions