Having difficulty trying to make UDF that removes a specific element from an array. Can't return the result array.

[OaklandJim]

I thought that this would be straightforward. I have of string values in one dimensional array. I want to develop code to remove the array element with a specified string. I'm pretty sure that the function is handling the task correctly. The difficulty I'm having is getting the result array in the UDF returned to the caller. I've tried a few ways but clearly I am missing something about how VBA handles arrays. Code below generates the Debug.Print results as shown below the code. What basic concept am I missing?

Option Explicit
Option Base 1

Sub test2()
    
    Dim arr1(1 To 4) As Variant

    arr1(1) = "A"
    arr1(2) = "B"
    arr1(3) = "C"
    arr1(4) = "D"
    
'   Causes "Can't assign to array" error.
'    arr1 = DeleteElement("B", arr1)

'   Send arr1 as byref parameter
    Call DeleteElement("B", arr1)
    
Debug.Print Chr(10) & "Elements in ByRef array parameter after processing"

Debug.Print arr1(1)
Debug.Print arr1(2)
Debug.Print arr1(3)
'Debug.Print DeleteElement(3) 'Causes error: parameters not optional.
End Sub

Function DeleteElement( _
    sValueToDelete As String, _
    pavList() As Variant) As Variant

    Dim iElementLoop As Long, iElementFound As Long

    Dim avResult() As Variant

    ReDim avResult(UBound(pavList) - 1)

    For iElementLoop = 1 To UBound(pavList)
        If pavList(iElementLoop) = sValueToDelete Then
            iElementFound = iElementLoop
            Exit For
        End If
    Next iElementLoop

'   Dim Results Array to have one fewer elements than the parameter array.
    ReDim avResult(UBound(pavList) - 1)

Debug.Print "Array element to omit = " & iElementFound

'   Loop array parameter to put the respective value into the results array.
'   Skips the parameter array element specified by iElementFound.
    For iElementLoop = 1 To UBound(pavList)
        If iElementLoop < iElementFound Then
            avResult(iElementLoop) = pavList(iElementLoop)

Debug.Print "< found index, result array = " & avResult(iElementLoop)

        ElseIf iElementLoop > iElementFound _
         Then
            avResult(iElementLoop - 1) = pavList(iElementLoop)

Debug.Print "> found index, result array = " & avResult(iElementLoop - 1)

        End If
    Next iElementLoop

'   ReDim then refill the ByRef array parameter.
'   This causes an error: Array is fixed or locked.
'    ReDim pavList(iElementLoop - 1)

'    Iterate the result array and refill the ByRef array that was resized above.
'    For iElementLoop = 1 To iElementLoop - 1
'        pavList(iElementLoop) = avResult(iElementLoop)
'    Next
'
'   Assign ByRef parameter to the results array. Causes a type mismatch error.
'    pavList() = avResult()
'    pavList = avResult

'   Assign ByVal parameter to the results array. Causes a type mismatch error.
'    pavList() = avResult()
'    pavList = avResult

Debug.Print "Ubound result array = " & UBound(avResult)

    DeleteElement = avResult

End Function

Array element to omit = 2
< found index, result array = A
> found index, result array = C
> found index, result array = D
Ubound result array = 3

Elements in ByRef array parameter after processing
A
B
C

 

[RoryA]

Use a dynamic array for arr1 so that you can then assign the result of the function to it.

 

[DanteAmor]

Instead of "deleting" the element, we will fill the result array with those that are different from the specified element.

Sub test2()
  Dim arr1() As Variant
  
  ReDim arr1(1 To 4)
  arr1(1) = "A"
  arr1(2) = "B"
  arr1(3) = "C"
  arr1(4) = "D"
  
  arr1 = DeleteElement("B", arr1)
  
  Debug.Print arr1(1)
  Debug.Print arr1(2)
  Debug.Print arr1(3)
End Sub

Function DeleteElement( _
  sValueToDelete As String, _
  pavList() As Variant) As Variant
  
  Dim i As Long, n As Long
  Dim avResult() As Variant
  ReDim avResult(1 To UBound(pavList) - 1)
  
  For i = 1 To UBound(pavList)
    If pavList(i) <> sValueToDelete Then
      n = n + 1
      avResult(n) = pavList(i)
    End If
  Next
  DeleteElement = avResult
End Function

 

[NdNoviceHlp]

To remove the item from the array...

Function RemoveItem(Rcnt As Integer, InArr As Variant) As Variant
Dim i As Integer, TempArr As Variant
'remove rcnt item from InArr. Return RemoveItem as array
ReDim TempArr(UBound(InArr) - 1)
For i = LBound(TempArr) To Rcnt - 2
TempArr(i) = InArr(i)
Next i
For i = Rcnt - 1 To UBound(TempArr)
TempArr(i) = InArr(i + 1)
Next i
RemoveItem = TempArr
End Function

eg....

Dim Arr As Variant, Msg As String, cnt As Integer
Arr = Array("A", "B", "C", "D")
Arr = RemoveItem(2, Arr)
For cnt = LBound(Arr) To UBound(Arr)
Msg = Msg & Arr(cnt)
Next cnt
MsgBox Msg

Also, above it seems like you were redimming the array. This empties the original array. Redim Preserve is needed unless you are replacing the whole array which is what the above code does. HTH. Dave

 

[OaklandJim]

DanteAmor

I sure appreciate the code. It works perfectly. My final version is below. Thank you soo much!

Jim

Function DeleteElementFromArray( _
  sValueToDelete As String, _
  pavList() As Variant) As Variant

'   Index used to keep track of which element in parameter array is being accessed.
    Dim iLoopIndex As Long
    
'   Index for accessing elements in the results array.
    Dim iResultIndex As Long
    
'   Local/temp results array.
    Dim avResult() As Variant
    
'   Iterate through all elements in the parameter array.
    For iLoopIndex = 1 To UBound(pavList)
        
'       If the parameter array element is not the same as the value to remove...
        If pavList(iLoopIndex) <> sValueToDelete _
         Then
         
'           Increment the results array index and redim the results array with iResultIndex
            iResultIndex = iResultIndex + 1
            ReDim Preserve avResult(iResultIndex)
          
'           Put the value from the parameter array into the local result array.
            avResult(iResultIndex) = pavList(iLoopIndex)
        End If
      
    Next

'   Return the results array to the caller.
    DeleteElementFromArray = avResult

End Function