Can't get rid of unwanted items from an array

Question

I'm trying to find out any way to kick out unwanted items from a list. For example, I wish to get rid of 47 and 90 from the list as they do not meet the condition. I've used Delete within the script which is definitely not the right keyword. However, consider it a placeholder.

I've tried with:

Sub DeleteItemConditionally()
    Dim numList As Variant, elem As Variant

    numList = Array("12", "47", "90", "15", "37")

    Debug.Print UBound(numList) - LBound(numList) + 1

    For Each elem In numList
        If elem >= 40 Then
            Delete elem
        End If
    Next elem

    Debug.Print UBound(numList) - LBound(numList) + 1
End Sub

Expected result:

First print : 5 (already getting it)
Second print: 3 (want to achieve it)

Answer 1

Note: This answer focuses on the question asked: how to conditionally delete items from an Array. Other answers deal with some of the many alternatives.

1. Your data. You've created an array of Strings then compared them to a Number. That won't work (well, it will give an answer, but it won't be what you expect). I've changed your data to Numbers

2. I've created the Delete functionality as a Function that returns a possibly reduced array. It only accepts 1D arrays (if anythig else is passed, the passed parameter is returned)

3. I've borrowed a couple of Utility Functions from CPearson.Com - BTW thats a great resource for all things VBA

4. I've included some flexibility for the test type, (>= or <) - you could add more if you want.

5. Speed. Whether or not this is fast enough depends on your use case. I've tested it as follows - Array Size of 5 run 1000 time in 3.9 mS. Array size of 10,000 runs 1000 times 586 mS

6. Included is an alternate version that can apply several of multiple conditions, >, >= <, <= a value must pass all tests to be kept (obviously, only certain conbinations make sence)

Sub Test()
    Dim numList As Variant

    numList = Array(12, 47, 90, 15, 37)

    Debug.Print UBound(numList) - LBound(numList) + 1

    numList = DeleteItemConditionally(numList, 40) ' Delete >= 40

    Debug.Print UBound(numList) - LBound(numList) + 1

End Sub

' Only 1 condition may be supplied
Function DeleteItemConditionally(Arr As Variant, Optional DeleteGEQ As Variant, Optional DeleteLES As Variant) As Variant
    Dim NewArr As Variant
    Dim iArr As Long, iNewArr As Long

    ' Check if Arr is valid
    If Not IsArrayAllocated(Arr) Then GoTo AbortExit
    If NumberOfArrayDimensions(Arr) <> 1 Then GoTo AbortExit

    ' that one and only one of Delete criteria is specified
    If Not (IsMissing(DeleteGEQ) Xor IsMissing(DeleteLES)) Then GoTo AbortExit

    ReDim NewArr(LBound(Arr) To UBound(Arr))

    If Not IsMissing(DeleteGEQ) Then
        ' Delete members >= DeleteGEQ
        iNewArr = LBound(Arr) - 1
        For iArr = LBound(Arr) To UBound(Arr)
            If Arr(iArr) < DeleteGEQ Then
                iNewArr = iNewArr + 1
                NewArr(iNewArr) = Arr(iArr)
            End If
        Next
    Else
        ' Delete members < DeleteGEQ
        iNewArr = LBound(Arr) - 1
        For iArr = LBound(Arr) To UBound(Arr)
            If Arr(iArr) >= DeleteGEQ Then
                iNewArr = iNewArr + 1
                NewArr(iNewArr) = Arr(iArr)
            End If
        Next
    End If

    ' ReDim Preserve is an expensive function, do it only once
    ReDim Preserve NewArr(LBound(Arr) To iNewArr)

    DeleteItemConditionally = NewArr
Exit Function
AbortExit:
    On Error Resume Next
    DeleteItemConditionally = Arr
End Function

' Several conditions may be supplied
Function DeleteItemConditionally2(Arr As Variant, Optional KeepGEQ As Variant, Optional KeepGRT As Variant, Optional KeepLEQ As Variant, Optional KeepLES As Variant) As Variant
    Dim NewArr As Variant
    Dim iArr As Long, iNewArr As Long
    Dim Keep As Boolean

    ' Check if Arr is valid
    If Not IsArrayAllocated(Arr) Then GoTo AbortExit
    If NumberOfArrayDimensions(Arr) <> 1 Then GoTo AbortExit

    ReDim NewArr(LBound(Arr) To UBound(Arr))

    iNewArr = LBound(Arr) - 1
    For iArr = LBound(Arr) To UBound(Arr)
        Keep = True
        If Not IsMissing(KeepGEQ) Then
            ' Keep members >= KeepGEQ
            If Arr(iArr) < KeepGEQ Then
                Keep = False
            End If
        End If
        If Keep And Not IsMissing(KeepGRT) Then
            ' Keep members > KeepGRT
            If Arr(iArr) <= KeepGRT Then
                Keep = False
            End If
        End If
        If Keep And Not IsMissing(KeepLEQ) Then
            ' Keep members <= KeepLEQ
            If Arr(iArr) > KeepLEQ Then
                Keep = False
            End If
        End If
        If Keep And Not IsMissing(KeepLES) Then
            ' Keep members < KeepLES
            If Arr(iArr) >= KeepGRT Then
                Keep = False
            End If
        End If

        If Keep Then
            iNewArr = iNewArr + 1
            NewArr(iNewArr) = Arr(iArr)
        End If
    Next

    ' ReDim Preserve is an expensive function, do it only once
    ReDim Preserve NewArr(LBound(Arr) To iNewArr)

    DeleteItemConditionally2 = NewArr
Exit Function
AbortExit:
    On Error Resume Next
    DeleteItemConditionally2 = Arr
End Function

Public Function IsArrayAllocated(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayAllocated
' Returns TRUE if the array is allocated (either a static array or a dynamic array that has been
' sized with Redim) or FALSE if the array is not allocated (a dynamic that has not yet
' been sized with Redim, or a dynamic array that has been Erased). Static arrays are always
' allocated.
'
' The VBA IsArray function indicates whether a variable is an array, but it does not
' distinguish between allocated and unallocated arrays. It will return TRUE for both
' allocated and unallocated arrays. This function tests whether the array has actually
' been allocated.
'
' This function is just the reverse of IsArrayEmpty.
'
' From http://www.cpearson.com/Excel/VBAArrays.htm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim N As Long
On Error Resume Next

' if Arr is not an array, return FALSE and get out.
If IsArray(Arr) = False Then
    IsArrayAllocated = False
    Exit Function
End If

' Attempt to get the UBound of the array. If the array has not been allocated,
' an error will occur. Test Err.Number to see if an error occurred.
N = UBound(Arr, 1)
If (Err.Number = 0) Then
    ''''''''''''''''''''''''''''''''''''''
    ' Under some circumstances, if an array
    ' is not allocated, Err.Number will be
    ' 0. To acccomodate this case, we test
    ' whether LBound <= Ubound. If this
    ' is True, the array is allocated. Otherwise,
    ' the array is not allocated.
    '''''''''''''''''''''''''''''''''''''''
    If LBound(Arr) <= UBound(Arr) Then
        ' no error. array has been allocated.
        IsArrayAllocated = True
    Else
        IsArrayAllocated = False
    End If
Else
    ' error. unallocated array
    IsArrayAllocated = False
End If

End Function

Public Function NumberOfArrayDimensions(Arr As Variant) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NumberOfArrayDimensions
' This function returns the number of dimensions of an array. An unallocated dynamic array
' has 0 dimensions. This condition can also be tested with IsArrayEmpty.
'
' From http://www.cpearson.com/Excel/VBAArrays.htm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
' Loop, increasing the dimension index Ndx, until an error occurs.
' An error will occur when Ndx exceeds the number of dimension
' in the array. Return Ndx - 1.
Do
    Ndx = Ndx + 1
    Res = UBound(Arr, Ndx)
Loop Until Err.Number <> 0

NumberOfArrayDimensions = Ndx - 1

End Function

Answer 2

Adding and removing additional elements to arrays is rather slow. And changing dimensions of arrays with Redim is one of the slowest operations in VBA. Anyway, if we are talking about up to a decent number of cases, then the speed is ok:

Option Explicit

Sub DeleteItemConditionally()

    Dim numList As Variant
    numList = Array(12, 47, 90, 15, 3)

    Dim newElements() As Variant
    Dim firstElement As Boolean: firstElement = True
    Dim i As Long

    For i = LBound(numList) To UBound(numList)
        If numList(i) <= 40 Then
            If firstElement Then
                ReDim Preserve newElements(0)
                firstElement = False
            Else
                ReDim Preserve newElements(UBound(newElements) + 1)
            End If

            newElements(UBound(newElements)) = numList(i)

        End If
    Next

    Dim element As Variant
    For Each element In newElements
        Debug.Print element
    Next

End Sub

With a Collection or with System.Collections.ArrayList as in the case below, the optimization and the speed would be way faster (but still slightly invisible, if the data is not more than a few hundred items). Additionally, a collection could be sorted rather quickly and then the speed of the task will be even better:

Sub TestMyCollection()

    Dim myList As Object
    Set myList = CreateObject("System.Collections.ArrayList")

    With myList
        .Add 12
        .Add 47
        .Add 90
        .Add 15
        .Add 3
    End With

    myList.Sort
    Dim i As Long
    For i = myList.Count - 1 To 0 Step -1
        If Not myList.Item(i) <= 40 Then
            myList.RemoveAt i
        End If
    Next i

    Dim element As Variant
    For Each element In myList
        Debug.Print element
    Next

End Sub

Additionally, to increase performance and to get some good usage of the .Sort() after the first number, bigger than 40 the For i = myList.Count - 1 To 0 Step -1 could exit.

Answer 3

If you are using a single dimension array to represent a list then you will be much better served by replacing your array with a collection (or if you wish to be more advanced a Scripting.Dictionary).

If you replace your array with a collection then essentially you don't need to make any significant changes to your code. Just a few minor tweaks to compensate for the fact that you can't query a collection to get the index of an item so you have to iterate by index rather than by item in your particular case.

I've updated your code to add a function that replaces the Array method by returning a populated Collection, and updates the loop to use indexing. You should also note that the indexing loop counts down. This is because if we remove an item from a collection, the size will no longer be the count we obtained at the start of the loop.

Sub DeleteItemConditionally()

Dim my_num_list As Collection, my_item_index As Long

    Set my_num_list = FilledCollection("12", "47", "90", "15", "37")

    Debug.Print my_num_list.Count

    For my_item_index = my_num_list.Count To 1 Step -1

        If my_num_list(my_item_index) >= 40 Then

            my_num_list.Remove my_item_index

        End If

    Next

    Debug.Print my_num_list.Count

End Sub

Public Function FilledCollection(ParamArray args() As Variant) As Collection

Dim my_return                       As Collection
Dim my_item                         As Variant

    Set my_return = New Collection

    For Each my_item In args

        my_return.Add my_item

    Next

    Set FilledCollection = my_return

End Function