How can I speed up my RemoveAt procedure?

[foodgood]

I am trying to recreate the Collection's Remove procedure, except I am trying to use it on an array instead of on a collection. I am trying to emulate the open source Java ArrayList code.

As you can see from the RemoveAt sub below, I am simply copying all elements located to the right of the removed element, then pasting those elements on top of the removed element,and finally emptying the element at the very end of the array.

This method works extremely fast if you are removing an element from the very end of the array (because in that case,it doesn't have to copy anything), but if you are trying to remove a bunch of elements from the middle of a large (1,000+ elements) array, forget about it! It takes over 10 seconds to remove 3,000 elements in the middle part of a 5,000 element array. Meanwhile, a collection can easily do the same in under .5 seconds.

Does anyone have any ideas for how I can speed up my RemoveAt procedure?

Private elementData() As Variant
Public size As Long

Public Function getArrayEls(ByVal StartingIndex As Long, ByVal EndingIndex As Long) As Variant()
    Dim els() As Variant
    ReDim els(EndingIndex - StartingIndex)

    Dim i As Long
    Dim j As Long
    j = 0
    For i = StartingIndex To EndingIndex
        If Not IsObject(elementData(i)) Then
            els(j) = elementData(i)
        Else: Set els(j) = elementData(i)
        End If
        j = j + 1
    Next i
    
    getArrayEls = els
End Function

Public Function arrayCopy(array1() As Variant, ByVal startingIndex1 As Long, array2() As Variant, _
  startingIndex2 As Long, ByVal TotalElements As Long)
    
    'copies from arr1, starting at stindex1, to arr2, starting at stindex2, totalelements.

    Dim i As Long
    Dim j As Long
    j = startingIndex2
    For i = startingIndex1 To startingIndex1 + TotalElements
        If Not IsObject(array1(i)) Then
            array2(j) = array1(i)
        Else: Set array2(j) = array1(i)
        End If
        j = j + 1
    Next i
End Function


Public Sub RemoveAt(ByVal Index As Long)
    'removes the element at the index and shifts everything (to the right) to the left 1
    
   'validates that the index is within bounds
   checkIndex (Index)
   
    If Index = size - 1 Then
        elementData(size - 1) = Empty
    Else
        'get all the elements to the right of the given index
        Dim rightOf() As Variant
        rightOf = Me.getArrayEls(Index + 1, size - 1)

        'copy rightOf into the AL's elements, starting at the removed index
        Call Me.arrayCopy(rightOf, 0, elementData, Index, UBound(rightOf))

        'get rid of the element at the end
        elementData(size - 1) = Empty
    End If
    
    size = size - 1
End Sub

[Bob Phillips]

Cross-posted at Excel Forum http://www.excelforum.com/excel-prog...ml#post2592480

[Paul_Hossler]

If the elements are all the same size, and you're VERY careful, the CopyMemory API might be used to copy the N+1-th element to the N-th position, and then you could Empty the now unused previous last element

Paul


BTW:

Welcome to the forum
+1 for using VBA tags
-1 for forgetting to indicate that it was cross-posted