Can't get rid of unwanted items from an array - arrays

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

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 2

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

Answer 3

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.
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
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)
I've borrowed a couple of Utility Functions from CPearson.Com - BTW thats a great resource for all things VBA
I've included some flexibility for the test type, (>= or <) - you could add more if you want.
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
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