Checking for a value in an array

Question

I am using the function from this question, however it does not seem to work in my case.

Basically, this script goes through a column that selects different values ​​for it and populates the arr array. If first checks to see if the column has ended to avoid calling an empty array. I have the first IfElse , and finally I want to check a non-empty array for the cell string. If it is not there, I want to add it.

 Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) End Function Sub SelectDistinct() Dim arr() As String Dim i As Integer Dim cells As Range Set cells = Worksheets("types").Columns("A").Cells i = 0 For Each cell In cells If IsEmpty(cell) Then Exit For ElseIf i = 0 Then ReDim Preserve arr(i) arr(UBound(arr)) = cell i = i + 1 ElseIf IsInArray(cell.Value, arr) = False Then ReDim Preserve arr(i) arr(UBound(arr)) = cell i = i + 1 End If Next cell End Sub 

For some reason, it throws a "Subtit out of range" error when calling the IsInArray function. Can someone tell me where I was wrong?

Answer 1

Here's how I would do it for a one-dimensional array using the Application.Match function instead of another UDF.

I combined some If / ElseIf logic with a Do...While loop, and then I'll use the Match function to check if a cell value exists in the array. If it does not exist, add it to the array and go to the next cell in your range.

 Sub SelectDistinct() Dim arr() As String Dim i As Integer Dim cells As Range Dim cl As Range Dim foundCl As Boolean Set cells = Worksheets("Sheet6").Columns(1).cells Set cl = cells.cells(1) Do If IsError(Application.Match(cl.Value, arr, False)) Then ReDim Preserve arr(i) arr(i) = cl i = i + 1 Else: 'Comment out the next line to completely ignore duplicates' MsgBox cl.Value & " already exists!" End If Set cl = cl.Offset(1, 0) Loop While Not IsEmpty(cl.Value) End Sub 

Answer 2

The short answer to your “Invalid range” error when calling the IsInArray function is that the arr variable is arr as Variant . For the Filter function to work in IsInArray > UDF, arr must be darkened as a String .

You can try the following code: 1) Installs the filtered array of String and 2) avoids placing Redim Preserve (which is an expensive function) in a loop:

 Sub FilteredValuesInArray() 'http://stackoverflow.com/questions/16027095/checking-if-value-present-in-array Dim rng As Range Dim arrOriginal() As Variant, arrFilteredValues() As String Dim arrTemp() As String Dim strPrintMsg As String 'For debugging Dim i As Long, lCounter As Long Set rng = Cells(1, 1).CurrentRegion 'You can adjust this how you want arrOriginal = rng 'Convert variant array to string array ReDim arrTemp(LBound(arrOriginal) - 1 To UBound(arrOriginal) - 1) For i = LBound(arrOriginal) To UBound(arrOriginal) arrTemp(i - 1) = CStr(arrOriginal(i, 1)) Next i 'Setup filtered values array ReDim arrFilteredValues(LBound(arrTemp) To UBound(arrTemp)) On Error Resume Next Do arrFilteredValues(lCounter) = arrTemp(0) 'Save non matching values to temporary array arrTemp = Filter(arrTemp, arrTemp(0), False) 'If error all unique values found; exit loop If Err.Number <> 0 Then Exit Do lCounter = lCounter + 1 Loop Until lCounter >= UBound(arrFilteredValues) On Error GoTo 0 'Resize array to proper bounds ReDim Preserve arrFilteredValues(LBound(arrFilteredValues) To lCounter - 1) '====DEBUG CODE For i = LBound(arrFilteredValues) To UBound(arrFilteredValues) strPrintMsg = strPrintMsg & arrFilteredValues(i) & vbCrLf Next i Debug.Print vbTab & "Filtered values are:" & vbCrLf & strPrintMsg '====END DEBUG CODE End Sub 

Answer 3

Here's a light but dirty hack:

 Function InStringArray(str As String, a As Variant) As Boolean Dim flattened_a As String flattened_a = "" For Each s In a flattened_a = flattened_a & "-" & s Next If InStr(flattened_a, str) > 0 Then InStringArray = True Else InStringArray = False End If End Function