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

OaklandJim

Well-known Member
Joined
Nov 29, 2018
Messages
878
Office Version
  1. 365
Platform
  1. Windows
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?

VBA Code:
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
 
Use a dynamic array for arr1 so that you can then assign the result of the function to it.
 
Upvote 0
Instead of "deleting" the element, we will fill the result array with those that are different from the specified element.

VBA Code:
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

🙃
 
Upvote 0
To remove the item from the array...
VBA Code:
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....
VBA Code:
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
 
Upvote 0
DanteAmor

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

Jim

VBA Code:
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
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top