I\'m using a function from this question, however, it doesn\'t seem to work in my case.
Basically, this script is going through a column selecting distinct values an
Short answer to your "Subscript out of range" error on the call of IsInArray
function" question is that the variable arr
is dimmed as Variant
. For the Filter
function to work in the IsInArray
UDF arr
must be dimmed as a String
.
You can try the following code which 1) Sets up a filtered String
array, and 2) avoids placing Redim Preserve
(which is a costly 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