VBA Removing duplicates values in an array includi

Question

There is a way to remove all duplicates in array with VBA, also the first value. Just keeping the not Duplicated values

Example:

Array_1 ['pedro','maria','jose','jesus','pepe','pepe','jose']

Result:

Array_1 ['pedro','maria','jesus']

Answer 1

Here is another version:

Public Sub ShortVersion()
    Dim varInput: varInput = Array("pedro", "pedro maria", "maria", "jose", "jesus", "pepe", "pepe", "jose")
    Dim colOutput As Collection: Set colOutput = New Collection
    Dim i As Long: For i = LBound(varInput) To UBound(varInput)
        If UBound(Split(Chr(1) & Join(varInput, Chr(1) & Chr(1)) & Chr(1), Chr(1) & varInput(i) & Chr(1))) = 1 Then
            colOutput.Add varInput(i)
        End If
    Next i
End Sub

Advantages:

• Shorter code
• The decision criterion is independent of later iterations of the loop, so if you build it in your algorithm, you can proceed with the first element without waiting for the decision about later ones
• Does not rely on MS Scripting Runtime

Disadvantages:

• Less efficient for larger arrays
• Outputs a Collection instead of an array (requires a loop to convert into an array if that is needed)
• Assumes that the array contains only text and that ASCII 1 (SOH) does not appear anywhere (which is quite probable, however)

Answer 2

Try this code:

Sub Remove_All_Duplicated()
Dim Array_1
    Array_1 = Array("pedro", "maria", "jose", "jesus", "pepe", "pepe", "jose")
Dim Array_2()

Dim eleArr_1, x
x = 0
For Each eleArr_1 In Array_1
    If UBound(Filter(Array_1, eleArr_1)) = 0 Then
        ReDim Preserve Array_2(x)
        Array_2(x) = eleArr_1
        x = x + 1
    End If
Next

End Sub

Additional solution as Filter function doesn't care about 'exact match'. This new one requires reference to Microsoft Scripting Runtime in VBA project.

Sub alternative()
Dim Array_1
    Array_1 = Array("pedro", "pedro maria", "maria", "jose", "jesus", "pepe", "pepe", "jose")
Dim Array_2()
Dim Array_toRemove()

Dim dic As New Scripting.Dictionary
Dim arrItem, x As Long
For Each arrItem In Array_1
    If Not dic.Exists(arrItem) Then
        dic.Add arrItem, arrItem
    Else
        ReDim Preserve Array_toRemove(x)
        Array_toRemove(x) = dic.Item(arrItem)
        x = x + 1
    End If
Next
For Each arrItem In Array_toRemove
    dic.Remove (arrItem)
Next arrItem
Array_2 = dic.Keys

'quic tests to remove when unnecessary
Debug.Print UBound(Array_2), UBound(Array_toRemove)
Debug.Print Join(Array_2, "/")

End Sub

Answer 3

How create a new A_temp1() without duplicates, using Filter() VBA function:

    Dim A_temp1() As String
    Dim NUMERO1 As Long
    Dim NUMERO2 As Long
    Dim DATO1 As Variant

NUMERO1 = 0
For Each DATO1 In Array_1
    If UBound(Filter(Array_1, DATO1)) > 0 Then
        Array_1(NUMERO1) = vbNullString
    End If
    NUMERO1 = NUMERO1 + 1
Next DATO1

NUMERO2 = 0
For NUMERO1 = LBound(Array_1) To UBound(Array_1)
    If Array_1(NUMERO1) <> vbNullString Then
    ReDim Preserve A_temp1(NUMERO2)
    A_temp1(NUMERO2) = Array_1(NUMERO1)
    NUMERO2 = NUMERO2 + 1
    End If
Next NUMERO1