Remove Duplicates from a 1D array in VBA

[450nick]

I'm trying to take a list of data (1D array as variant containing lots of text inputs) and run this input array into a function which returns another array with a filtered list of maybe 8 unique entries from around 700+ in the input array. So far I have this, but I'm getting a type-mismatch error with the VBA filter - any ideas why?:

Function RemoveDupes(InputArray) As Variant


Dim Array_2()


Dim eleArr_1 As Variant
Dim x As Integer


x = 0
On Error Resume Next
For Each eleArr_1 In InputArray
If UBound(Filter(InputArray, eleArr_1)) = 0 Then
ReDim Preserve Array_2(x)
Array_2(x) = eleArr_1
x = x + 1
End If
Next
RemoveDupes = Array_2

End Function

 

[DEksel]

it giving error out of range

You should post your code. Probably you made some mistake.
Suppose you have data in range A1-A9 like
January
February
March
January
April
February
May
January
June
When you transpose all of that (that range) into Temp array, first index will be 1 (print arrTmp(0) will return the error). After function 'RemoveDupes' everything will become ok: first index 0 and no duplicates.
Full example:

Function Work_A()
Dim arr As Variant, arrTmp As Variant, s As Range, rng As Range, element
    Set wsC = Worksheets("Calc")
    Set s = wsC.Range("A1")
    Set rng = Range(s, s.End(xlDown))
    arrTmp = Application.Transpose(rng.Value)
    Debug.Print "Temp array"
    Debug.Print "The 1st array index is 1 - " & arrTmp(1)
    Debug.Print ""
    For Each element In arrTmp
        Debug.Print element
    Next
    Debug.Print ""
    '-- This wil shift array from 1 beg to 0 beg and remove duplicates.
    arr = RemoveDupes(arrTmp)
    Debug.Print "New array"
    Debug.Print "The 1st array index is 0 (next is 1 means 2nd array element) - " & arr(1)
    Debug.Print ""
    For Each element In arr
        Debug.Print element
    Next
    Debug.Print " "
End Function

'----------------------------------------------------------------
Function RemoveDupes(InputArray As Variant) As Variant
'----------------------------------------------------------------
Dim x As Long
With CreateObject("Scripting.Dictionary")
    For x = LBound(InputArray) To UBound(InputArray)
        If Not IsMissing(InputArray(x)) Then .Item(InputArray(x)) = 1
    Next
    RemoveDupes = .Keys
End With
End Function