Delete multiple elements (solved)

[sweevo]

Hello,

How can I delete an element from an array if it has already occurred?

e.g.

1 example
2 elements
3 for
4 example
5 array

Would become...

1 example
2 elements
3 for
4 array

Thanks

[darre1]

either copy the array to a new array, or use a dynamic array...

then you can redim it using the preserve keyword.

i.e.

Redim Preserve aMyArray(3)

will set the upperbound of the 1st dimension to 3 (4 elements), thus destroying the 5th element, but keeping the existing 4 - becuase you used the Preserve keyword

[sweevo]

Thanks, but how can I work through the elements and delete reoccurring ones, assuming I don't know the contents?

[darre1]

well i think the best way would be to copy the elements accross to another array and as you copy each one accross, first check whether it already exists in the new array.

[plenderj]

Originally posted by sweevo
Hello,

How can I delete an element from an array if it has already occurred?

e.g.

1 example
2 elements
3 for
4 example
5 array

Would become...

1 example
2 elements
3 for
4 array

Thanks

This is not actually an easy thing to do ya know

[sweevo]

Hmmm... I thought as much, because I couldn't find a way to do it. I did think that maybe I was missing something reasonably simple, as I often do, but evidently not.

Darre, I'll give it a go.

Cheers

[plenderj]

Add a reference to the microsoft scripting runtime library (Project > References), then use this code

Option Explicit
 
Private Sub removeDuplicates(ByRef arrName() As String)
    Dim i As Long, tempArr() As String: ReDim tempArr(UBound(arrName))
    Dim d As New Dictionary, n As Long
    For i = 0 To UBound(arrName)
        If Not d.Exists(arrName(i)) Then
            d.Add arrName(i), arrName(i)
            tempArr(n) = arrName(i): n = n + 1
        End If
    Next
    ReDim Preserve tempArr(n)
    arrName = tempArr
End Sub
 
Private Sub Form_Load()
    Dim x() As String: ReDim x(10)
    x(0) = "a"
    x(1) = "b"
    x(2) = "c"
    x(3) = "d"
    x(4) = "a"
    x(5) = "b"
    x(6) = "c"
    x(7) = "d"
    x(8) = "a"
    x(9) = "b"
    x(10) = "c"
    
    removeDuplicates x
    
    Dim i As Long
    For i = 0 To UBound(x) - 1
        Debug.Print i & ":" & x(i)
    Next
End Sub

[darre1]

ang on... i'll have a bash at the code...

[darre1]

why you need scripting runtime plenderj?

[plenderj]

For the dictionary object.
Its the fastest way (IMHO) to remove duplicates from arrays etc.

[sweevo]

Hey that's excellent, thanks.

[darre1]

well i just wrote this and it worked

Option Explicit
 
Private Sub RemoveDuplicates(ByRef vArray As Variant)
'removes duplicate items from an array
On Error GoTo ErrorHandler
    
    Dim aTemp() As String
    Dim i As Long
 
    If Not IsArray(vArray) Then Exit Sub
    
    'Go through each item in the array
    For i = LBound(vArray) To UBound(vArray)
        'Only add if not in array already
        If Not InArray(aTemp, vArray(i)) Then
            ReDim Preserve aTemp(UBound(aTemp) + 1)
            aTemp(UBound(aTemp)) = vArray(i)
        End If
    Next i
    
    vArray = aTemp
    
    Erase aTemp
    
    Exit Sub
    
ErrorHandler:
    If Err.Number = 9 Then
        ReDim aTemp(0)
        Resume Next
    Else
        MsgBox Err.Description, , Err.Number
    End If
End Sub
 
 
Private Function InArray(ByVal vArray As Variant, ByVal vItem As Variant) As Boolean
On Error GoTo ErrorHandler
 
    Dim i As Long
    
    If Not IsArray(vArray) Then Exit Function
    
    For i = LBound(vArray) To UBound(vArray)
        If vArray(i) = vItem Then
            InArray = True
            Exit For
        End If
    Next i
 
    Exit Function
 
ErrorHandler:
    If Err.Number = 9 Then
        'nothing - subscript out of range
    Else
        MsgBox Err.Description, , Err.Number
    End If
End Function
 
Private Sub Form_Load()
    Dim aMyArray() As String
    Dim i As Long
    
    ReDim aMyArray(5)
    
    aMyArray(0) = "Bob"
    aMyArray(1) = "Bib"
    aMyArray(2) = "Bab"
    aMyArray(3) = "Bub"
    aMyArray(4) = "Bob"
    aMyArray(5) = "Beb"
    
    RemoveDuplicates aMyArray
    
    For i = LBound(aMyArray) To UBound(aMyArray)
        MsgBox aMyArray(i)
    Next i
End Sub

[plenderj]

Yeah there's two ways to do it ;

Use the dictionary object - extremely fast
Loop back through array for each element of array - extremely slow

So take your pick

[darre1]

i'm gonna have a look at this dictionary object then, haven't come accross that before