[RESOLVED] Delete item(s) from array

[Ellis Dee]

This should be super simple, but I'm tired and pressed for time. How do you remove items from an array based on a criteria? For example, if your array is:

MyArray(0) = "A"
MyArray(1) = "B"
MyArray(2) = "C"
MyArray(3) = "B"
MyArray(4) = "B"

Deleting all the B's, you end up wth:

MyArray(0) = "A"
MyArray(1) = "C"

The actual arrays are udts, so I can't use the native Filter() command or anything like it.

[RhinoBull]

You will have to loop through and "filter out" unnecessary items manually, write "what's left" (basically If not current_item = filter_value Then) into another array and finally (if necessary) reassign your original array to temp one.
Something like this should work:

Private Sub Command1_Click()
Dim myArray() As String
Dim tmpArray() As String
Dim i As Integer
Dim myFilter As String

    ReDim myArray(4)
    myFilter = "b"
    
    myArray(0) = "A"
    myArray(1) = "B"
    myArray(2) = "C"
    myArray(3) = "B"
    myArray(4) = "B"
    
    ReDim tmpArray(0)
    
    For i = 0 To UBound(myArray)
        If Not UCase(myArray(i)) = UCase(myFilter) Then
            tmpArray(UBound(tmpArray)) = myArray(i)
            ReDim Preserve tmpArray(UBound(tmpArray) + 1)
        End If
    Next i
    ReDim Preserve tmpArray(UBound(tmpArray) - 1)
    
    ReDim myArray(UBound(tmpArray))
    myArray = tmpArray
    
    For i = 0 To UBound(myArray)
        Debug.Print myArray(i)
    Next i

End Sub

[Ellis Dee]

I'm looking to do it in-place.

I can easily picture the logic in my head, but I can't seem to actually write it. I keep ending up with multiple nested loops, and I know it can be done with a single elegant loop.

Unfortunately, I have a million things to finish in the next two hours, so I can't spend an hour on this one thing. Somebody who isn't quite as tired could probably hammer this out in about 5 minutes; I'm hoping that person is reading this thread and feels like helping.

[LaVolpe]

If the array is not sorted or indexed some way, you have no option that I can think of, other than touching each array element to find the ones "to be deleted". Once you find one, you can swap it with the last array item, decrease array count, look for next one until all items were searched. If any were found, you can ReDim Preserve your array to the new array count; thereby permanently deleting those items.

Depending on how many items your array contains, you may want to consider keeping your array sorted or indexed (binary tree for example).

[BruceG]

You can use the Filter function for this (its a lesser-known function in the "Split" and "Join" family). Try this:
MyArray = Filter(MyArray, "B", False)

[Ellis Dee]

You can use the Filter function for this (its a lesser-known function in the "Split" and "Join" family). Try this:
MyArray = Filter(MyArray, "B", False)

From the OP:

The actual arrays are udts, so I can't use the native Filter() command or anything like it.

[Ellis Dee]

If the array is not sorted or indexed some way, you have no option that I can think of, other than touching each array element to find the ones "to be deleted". Once you find one, you can swap it with the last array item, decrease array count, look for next one until all items were searched. If any were found, you can ReDim Preserve your array to the new array count; thereby permanently deleting those items.

Depending on how many items your array contains, you may want to consider keeping your array sorted or indexed (binary tree for example).

Sorting touches each element way more than once, so it would be less efficient to sort it just for this.

The array is actually already sorted, but it's sorted on a different column.

[Ellis Dee]

Here's the concept:

In a single loop, you have two position counters, both of which initially point to the first element. One counter holds the insertion point, the other holds the source point.

Using an extended version of the example from the OP:

MyArray(0) = "A"
MyArray(1) = "B"
MyArray(2) = "C"
MyArray(3) = "B"
MyArray(4) = "B"
MyArray(5) = "D"
MyArray(6) = "B"
MyArray(7) = "B"

The first change will happen when insertion is 1 and source is 2. The second change will happen when the insertion is 2 and the source is 5. No other changes take place. We finish with ReDim MyArray(insertion).

The whole thing will likely be around a dozen lines of code.

[LaVolpe]

Well, do the "B"s get deleted actually? If so, my first post is a relatively easy way to do it if the order is not important. If the "B"s do get deleted and order is important, then array shifting using CopyMemory can be an option. If the "B"s actually do not get deleted but just filtered out, then RhinoBull's solution should work well and also seems a good solution for deletion and keeping the order in tact.

[Ellis Dee]

They get permanently deleted, and the order is important.

[Ellis Dee]

RhinoBull's solution should work well and also seems a good solution for deletion and keeping the order in tact.

His solution is highly inefficient; way too inefficient for my needs.

[LaVolpe]

Try this. The important code is between the dashed lines. If you need clarification on anything, ask.

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Type TESTUDT
    A As Long
    B As String
    C() As Long
    D As Byte
End Type

Private Sub Command1_Click()

    Dim myUDT() As TESTUDT
    Dim Index As Long, Count As Long
    Dim nullUDT() As Byte, lenUDT As Long
    
    ReDim myUDT(0 To 20)
    For Index = 0 To UBound(myUDT)
        myUDT(Index).B = Chr$(Int(Rnd * 5) + 65)
    Next
    
    For Index = 0 To UBound(myUDT): Debug.Print myUDT(Index).B;: Next: Debug.Print
    
    '----------------------------------------------
    Count = UBound(myUDT)
    Index = LBound(myUDT)
    lenUDT = LenB(myUDT(Index))
    ReDim nullUDT(1 To lenUDT)
    
    Do Until Index => Count
        If myUDT(Index).B = "B" Then
            CopyMemory nullUDT(1), ByVal VarPtr(myUDT(Index)), lenUDT
            CopyMemory ByVal VarPtr(myUDT(Index)), ByVal VarPtr(myUDT(Index + 1)), (Count - Index) * lenUDT
            CopyMemory ByVal VarPtr(myUDT(Count)), nullUDT(1), lenUDT
            Count = Count - 1
        Else
            Index = Index + 1
        End If
    Loop
    If myUDT(Index).B = "B" Then Count = Count - 1

    
    If Count < LBound(myUDT) Then
        Erase myUDT
    ElseIf Count < UBound(myUDT) Then
        ReDim Preserve myUDT(LBound(myUDT) To Count)
    Else
         ' nothing was found to be deleted
    End If
    '----------------------------------------------

    For Index = 0 To UBound(myUDT): Debug.Print myUDT(Index).B;: Next: Debug.Print

End Sub

[dilettante]

This looks like a perfect example of why not to use UDTs and arrays of UDTs. They're largely carryovers of a bygone day, pre-Windows Basic.

A fabricated ADO Recordset (also known as Cursor Service Local Rowsets) will provide most of the functionality you need without such wheel reinventing and with relatively small performance impact. Even then you can tweak performance somewhat by using local indexes (Optimize Property-Dynamic) and even by caching Field references.

Clearly hard-coded logic using simple data structures can have important performance benefits, but usually the cost of development and debugging prohibits their use beyond simple cases. The Recordset will get you multi-field sorting as well as searching, filtering, ad hoc insert/delete, etc.

I often see threads like this and think "If you had used a Recordset you'd be home by now." It is one of the programmers' power tools in Windows.

[Ellis Dee]

Try this. The important code is between the dashed lines. If you need clarification on anything, ask.

That's almost perfect. The single loop approach is exactly what I'm looking for, but the CopyMemory is overkill. It's much simpler and plenty fast enough to just assign the udts directly. eg:

myUDT(Index) = myUDT(Count)

The problem is that it's unstable. The original order needs to be preserved.

[Ellis Dee]

This looks like a perfect example of why not to use UDTs and arrays of UDTs. They're largely carryovers of a bygone day, pre-Windows Basic.

A fabricated ADO Recordset (also known as Cursor Service Local Rowsets) will provide most of the functionality you need without such wheel reinventing and with relatively small performance impact. Even then you can tweak performance somewhat by using local indexes (Optimize Property-Dynamic) and even by caching Field references.

Clearly hard-coded logic using simple data structures can have important performance benefits, but usually the cost of development and debugging prohibits their use beyond simple cases. The Recordset will get you multi-field sorting as well as searching, filtering, ad hoc insert/delete, etc.

I often see threads like this and think "If you had used a Recordset you'd be home by now." It is one of the programmers' power tools in Windows.

Yeah, no kidding. But I can't use recordsets for this particular project, so please take your witnessing elsewhere.

[Ellis Dee]

Typo, bug in what I posted. Checking it now

It's unstable because one counter is starting at the end and one from the beginning. They both have to start at the beginning.

[LaVolpe]

Well, from what I understand, you want to maintain the order of the array while deleting potentially multiple array items. I see only two options:

Option 1: In-Place. Use CopyMemory to shift array (faster) or use a loop to manually shift each item right of the "item to be deleted" to the left (slower for multiple reasons)

Option 2: Dup-Array. Copy each non-deleted item to another array

Option 3: ?

P.S. The code I posted is not unstable. The counters are done that way because of the potential of multiple array items that need to be deleted. When one item is deleted, the array shifts left, index remains the same, and the total number of array items is reduced. You know when you are done when the Index = array items. The final array items should be checked individually and reduce array count if it is to be deleted. It is far from unstable; did you run the updated code in a sample project. Make the array 100x larger if desired for the test

Edited: However, the Do:While loop will fail if the array contains only one item; subscript out of range. So, guess there was one small error left; patched in Post 12.

[Ellis Dee]

Option 1: In-Place. Use CopyMemory to shift array (faster) or use a loop to manually shift each item right of the "item to be deleted" to the left (slower for multiple reasons)

Option 2: Dup-Array. Copy each non-deleted item to another array

Option 1 is what I'm looking for. It will be much more efficient than Option 2.

CopyMemory is merely an optimization of Option 1, and it is not an optimization I view as particularly important.

Unstable refers to the fact that it doesn't preserve the original order.

[LaVolpe]

Ok, the stuff I posted does keep original order. It is simply shifting array items left in massive chunks. If you don't want to use copymemory, you can use the same logic with simple item assignment:

    Do Until Index >= Count
        If myUDT(Index).B = "B" Then
           For x = Index + 1 To Count
               myUDT(x - 1) = myUDT(x)
           Next
           Count = Count - 1
        Else '
            Index = Index + 1
        End If
    Loop
    If myUDT(Index).B = "B" Then Count = Count - 1

[Ellis Dee]

Huh, so it is. I swear the first time I ran it, it was unstable, but now it clearly retains the original order. My apologies, and many thanks, that's exactly what I was looking for.

[Ellis Dee]

My apologies, and many thanks, that's exactly what I was looking for.

On closer inspection, that interior loop that mimics CopyMemory is doing a ton more work than it needs to. It's moving the entire remainder of the array in a single block, like CopyMemory. But I don't need to move contiguous blocks; I only need to move the individual elements.

In a single-loop solution without CopyMemory, each preserved element will move exactly once. In both the CopyMemory and simulated CopyMemory solutions each element moves once for every filter element preceeding it.

Consider this array:

MyArray(0) = "B"
MyArray(1) = "B"
MyArray(2) = "B"
MyArray(3) = "B"
MyArray(4) = "B"
MyArray(5) = "B"
MyArray(6) = "B"
MyArray(7) = "B"
MyArray(8) = "B"
MyArray(9) = "A"

What I'm looking for will do exactly one swap: element 9 overwrites element 0. Then the array is redimmed to 0 and the deletion is complete.

The technique you're using will shift elements 2 through 9 left one, then elements 2 through 8 left one, then elements 2 through 7 left one, etc... until element 9 is finally shifted all the way to the beginning. Even with CopyMemory this would be much less efficient than what I'm trying to do.

I'll sit down and see if I can't hammer it out on my own.

[LaVolpe]

Your other posts, your examples did not show the array in sorted order

MyArray(0) = "A"
MyArray(1) = "B"
MyArray(2) = "C"
MyArray(3) = "B"
MyArray(4) = "B"

If the array is sorted as shown in your last posting, then it is easy, no?
1. Find first instance of item = B & cache index
2. Find next instance where item<>B then
a. either use copymemory to shift the array elements from 9 to 0, shifting LenB(UDT)*9 [fast]
b. loop x from 9 to n, assigning array(x-9)=array(x) [slower]

But if the last post was just an example showing that multiple instances can appear consecutively and also individually throughout the array, then both methods can still be used, but requires more complex looping. Here's an example of what I mean.
Dim NextItem, Range & LastItem as Longs

    Do Until Index >= Count
        If myUDT(Index).B = "B" Then
            LastItem = Index
            For NextItem = LastItem + 1 To Count - 1
                If myUDT(NextItem).B <> "B" Then Exit For
            Next
            If NextItem > LastItem + 1 Then ' found consecutive items
                Range = (NextItem - LastItem) * lenUDT
                If Range > UBound(nullUDT) Then ReDim nullUDT(1 To Range)
            Else
                Range = lenUDT
                NextItem = LastItem + 1
            End If
            CopyMemory nullUDT(1), ByVal VarPtr(myUDT(LastItem)), Range
            CopyMemory ByVal VarPtr(myUDT(LastItem)), ByVal VarPtr(myUDT(NextItem)), (Count - NextItem + 1) * lenUDT
            CopyMemory ByVal VarPtr(myUDT(Count - (NextItem - LastItem - 1))), nullUDT(1), Range
            Count = Count - (NextItem - LastItem)
        End If
        Index = Index + 1
    Loop
    If myUDT(Index).B = "B" Then Count = Count - 1

[Merri]

You may be interested of ArrayRemove – technically it is done in an entirely different way than LaVolpe's code, but the idea is the same as with CopyMemory. The major difference is that it supports any array without code modification. It could also be done with CopyMemory to shorten the code.


Edit
And as a side note, I didn't take a very detailed look on what is being actually done, but that function can be used to remove items from any array.

[Ellis Dee]

I finally got it working how I envisioned it. I suspect this is more efficient than CopyMemory, though I don't have time to benchmark right now.

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Type TESTUDT
    A As Long
    B As String
    C() As Long
    D As Byte
End Type

Private Sub Command1_Click()

    Dim myUDT() As TESTUDT
    Dim i As Long
    Dim nullUDT() As Byte, lenUDT As Long
    
    ReDim myUDT(0 To 20)
    For i = 0 To UBound(myUDT)
        myUDT(i).B = Chr$(Int(Rnd * 5) + 65)
    Next
    
    For i = 0 To UBound(myUDT): Debug.Print myUDT(i).B;: Next: Debug.Print
    
    '----------------------------------------------
    
    FilterUDT myUDT
    
    '----------------------------------------------

    For i = 0 To UBound(myUDT): Debug.Print myUDT(i).B;: Next: Debug.Print

End Sub

Private Sub FilterUDT(ptyp() As TESTUDT)
    Dim lngKeep As Long
    Dim lngSwap As Long
    Dim lngMax As Long
    
    lngMax = UBound(ptyp)
    ' Find first match
    For lngKeep = 0 To lngMax
        If ptyp(lngKeep).B = "B" Then Exit For
    Next
    If lngKeep > lngMax Then Exit Sub
    lngSwap = lngKeep + 1
    ' Main loop
    Do While lngSwap <= lngMax
        If ptyp(lngSwap).B <> "B" Then
            ptyp(lngKeep) = ptyp(lngSwap)
            lngKeep = lngKeep + 1
        End If
        lngSwap = lngSwap + 1
    Loop
    ReDim Preserve ptyp(lngKeep - 1)
End Sub

[Ellis Dee]

This would be an interesting contest to see what method is the fastest.

[RhinoBull]

I finally got it working how I envisioned it...

You said (in post #11) that sample code I posted is "highly inefficient" but how is what you've done different?

[Milk]

without meaning to be rude Rhino have you properly compared the two pieces of code, they are very different.

[Ellis Dee]

You said (in post #11) that sample code I posted is "highly inefficient" but how is what you've done different?

You create a temporary array one element at a time -- redimming each and every time you add an element to it -- and then when you're finished you copy it back over the original array. This is wasteful with both memory (using double what you need) and processing power. (ReDim Preserving inside a loop is possibly the least efficient technique there is.) Finally, each element that isn't deleted gets copied twice: once to the temporary array, and then once more at the end when the whole temporary array gets copied back over the original.

My solution is in-place, so it is optimally efficient with memory. It also ReDim Preserves exactly once, so that's optimally efficient as well. And finally, every preserved element gets copied exactly once, when it gets moved from its original location directly to its final destination in one operation.

That last bit is why I think my solution will be faster than a copymemory solution, because the copymemory solutions posted move each preserved element (and some to-be-deleted elements) multiple times before resolving them to their final destination.

[Merri]

An issue in your solution from being fully optimal is that since you copy entire structure including the string you are creating a new string each time an item moves (as well as removing the old one, of course). If this happens very early on in a processing of a large array you will see a noticeable slowdown when compared to a CopyMemory solution that does more copying within the actual array itself, but does not cause strings to be re-allocated.

There is the option of implementing your code with CopyMemory and to account for the special requirements involved with it (proper removal of data of items to be removed), but there still remains one thing that will cause problems: making an API call from VB is a bit slow, doing it in a loop multiple times could also be improved. This is where my "hackish" code sample could be used to improve performance, since it hacks data to be a fake string, which can then be handled with native Mid function to move stuff around in-place, avoiding API calls in a loop.

One could also then call it over optimization unless you are really dealing with lots of actual data. Or if you make it a generic function then it might actually be worth it.

[Ellis Dee]

Fair point. It would be interesting to see a benchmark, but I suspect that the results will vary wildly depending on the input.

[Merri]

I did something that works just for string arrays; didn't bother to start figuring out a good way to work with UDTs.

Option Explicit

Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
Private Declare Sub RtlMoveMemory Lib "ntdll" (Destination As Any, Source As Any, ByVal Bytes As Long)
Private Declare Function SafeArrayRedim Lib "oleaut32" (ByVal saPtr As Long, saBound As Long) As Long
Private Declare Function StrCmp Lib "msvbvm60" Alias "__vbaStrCmp" (ByVal String1 As Long, ByVal String2 As Long) As Long
Private Declare Function SysFreeString Lib "oleaut32" (ByVal BSTR As Long) As Long
Private Declare Function VarPtrArray Lib "msvbvm60" Alias "VarPtr" (Var() As Any) As Long

Public Sub FilterOut(ByRef SA() As String, ByRef Remove As String)
    Dim lngA As Long, lngB As Long, lngPtrRemove As Long, lngPtrSA As Long
    Dim lngArray() As Long, lngHeaderSA(5) As Long, lngNewDim(1) As Long
    ' get pointer to safe array header
    lngPtrSA = Not Not SA
    ' IDE error fix (this will not be compiled)
    Debug.Assert App.hInstance
    ' is the array initialized?
    If lngPtrSA Then
        ' get the safe array header information
        RtlMoveMemory lngHeaderSA(0), ByVal lngPtrSA, 24
        ' one dimension only, must have data, must not be locked
        If ((lngHeaderSA(0) And &HFFFF&) = 1) And (lngHeaderSA(3) <> 0) And (lngHeaderSA(2) = 0) Then
            ' remember base
            lngNewDim(1) = lngHeaderSA(5)
            ' zero base
            lngHeaderSA(5) = 0
            ' fast access string pointer
            lngPtrRemove = StrPtr(Remove)
            ' fake Long array to string array
            PutMem4 VarPtrArray(lngArray), VarPtr(lngHeaderSA(0))
            For lngA = 0 To UBound(lngArray)
                ' is string the same?
                If StrCmp(lngArray(lngA), lngPtrRemove) <> 0 Then
                    ' it is not, do we need to copy?
                    If lngB < lngA Then lngArray(lngB) = lngArray(lngA)
                    ' increase target position
                    lngB = lngB + 1
                Else
                    ' remove a string; this is equivalent of SA(lngA) = vbNullString
                    SysFreeString lngArray(lngA)
                End If
            Next lngA
            ' prevent removal of strings that we want to preserve
            For lngA = lngB To UBound(lngArray)
                lngArray(lngA) = 0
            Next lngA
            ' end fake
            PutMem4 VarPtrArray(lngArray), 0
            ' set number of items in resized array
            lngNewDim(0) = lngB
            ' resize array & done
            SafeArrayRedim lngPtrSA, lngNewDim(0)
        End If
    End If
End Sub

Sample:

Private Sub Form_Load()
    Dim strTest() As String
    ReDim strTest(0 To 9)
    strTest(0) = "A"
    strTest(1) = "A"
    strTest(3) = "A"
    strTest(9) = "A"
    
    strTest(2) = "0"
    strTest(4) = "1"
    strTest(5) = "2"
    strTest(6) = "3"
    strTest(7) = "4"
    strTest(8) = "5"
    FilterOut strTest, "A"
    
    Debug.Print Join(strTest, "-")
End Sub

[LaVolpe]

Ellis Dee. Your code should be faster overall I would think. As Merri points out, using APIs in loops can actually be slower than native VB commands. Especially in this case. Since the UDT has pointers, the CopyMemory can't just simply slide data from right to left, it must maintain the pointers (hence the 3 copymemory calls), otherwise, memory leaks from unreleased pointers or worse - crash as two or more pointers point to same data.

If the UDTs contained no pointers, then maybe CopyMemory could outperform because only a single copymemory call needs to be made vs three. And reworking the looping might prove beneficial for the API too.

[Ellis Dee]

For simple deletions CopyMemory will be much, much faster. For example, if you have 10,000 items and you're deleting just the very first element.

But consider if you have 10,000 random numbers between 1 and 4, and you want to remove all the 3's. In that scenario I think my method would be optimal. I could be wrong, but it just seems like calling CopyMemory 2500 times to move tiny chunks (or worse, the entire remainder of the array each time) would be far slower.

[Merri]

See it for yourself

My code is long and complex to follow, but that should be expected when optimizing so far as I did. I have great ways to spend "my brains don't really work but hey I can code" time before going to sleep!

If one wants to ensure it is safe to modify the UDT (add items, remove items), one should use LenB to determine the true length instead of using the hardcoded 16 that I put here and there.


Please note that if you use much longer strings and/or add actually data into the long array in the UDT items you will see Ellis Dee's code becoming much slower, while CopyMemory and my optimized remain about the same speed, only getting slower due to string comparisons. I however bothered to add a check for string length: strings can't be the same if they're not the same length and VB's string comparison doesn't check for it!

[Spoo]

Ellis Dee

Already resolved, I know, but here's my 2 cents...

kk = 0
kill = "B"
For ii = 0 to UBound(MyArray)
   If MyArray(ii) = kill Then
       kk = kk + 1
       MyArray(ii) = Empty
   Elseif kk > 0 Then
       MyArray(kk) = MyArray(ii)
       MyArray(ii) = Empty
   End If
Next ii

Hopefully you'd end up with...

MyArray(0) = "A"
MyArray(1) = "C"
MyArray(2) = Empty
MyArray(3) = Empty
MyArray(4) = Empty

Would that of use for you?
(note: composed the code frag in the post, have not tested yet -- I gotta run, but will come back later and check it)

Spoo

[Ellis Dee]

Yeah, pretty much what I expected. Nice benchmark, thanks.

Please note that if you use much longer strings and/or add actually data into the long array in the UDT items you will see Ellis Dee's code becoming much slower, while CopyMemory and my optimized remain about the same speed, only getting slower due to string comparisons. I however bothered to add a check for string length: strings can't be the same if they're not the same length and VB's string comparison doesn't check for it!

If by CopyMemory you mean LaVolpe's versions, they don't scale well. Leaving the string size the same but exponentially increasing the size of the udt array chokes both of his methods, while yours and mine remain peppy.

Even with very long strings, as soon as the number of array elements grows my method outperforms both of his.

[Ellis Dee]

kk = 0
kill = "B"
For ii = 0 to UBound(MyArray)
   If MyArray(ii) = kill Then
       kk = kk + 1
       MyArray(ii) = Empty
   Elseif kk > 0 Then
       MyArray(kk) = MyArray(ii)
       MyArray(ii) = Empty
   End If
Next ii

(note: composed the code frag in the post, have not tested yet -- I gotta run, but will come back later and check it)

Close; that's the idea I was going for. The specifics of your logic appear flawed, but the concept is correct.

Consider if the first element (0) is to be killed. kk becomes 1 and the first element is zeroed. Next iteration of the loop, both kk and ii are 1, so element 0 can never be overwritten, which it should be since it met the kill criteria.

I posted the finished version in post 24, reproduced here:

Private Sub FilterUDT(ptyp() As TESTUDT)
    Dim lngKeep As Long
    Dim lngSwap As Long
    Dim lngMax As Long
    
    lngMax = UBound(ptyp)
    ' Find first match
    For lngKeep = 0 To lngMax
        If ptyp(lngKeep).B = "B" Then Exit For
    Next
    If lngKeep > lngMax Then Exit Sub
    lngSwap = lngKeep + 1
    ' Main loop
    Do While lngSwap <= lngMax
        If ptyp(lngSwap).B <> "B" Then
            ptyp(lngKeep) = ptyp(lngSwap)
            lngKeep = lngKeep + 1
        End If
        lngSwap = lngSwap + 1
    Loop
    ReDim Preserve ptyp(lngKeep - 1)
End Sub

[Ellis Dee]

Incidentally, I am convinced my solution can be re-written using a single loop. I put in that initial For...Next loop because I was in a rush and wanted to keep things simple. I don't think it's strictly necessary, but even now with a little more time to look at it I can't get my head around how to incorporate it into the main loop.

EDIT: And the main Do..While loop is screaming to be rewritten as a For...Next loop. That's definitely a rush job. Here's a cleaner version:

Private Sub FilterUDT(ptyp() As TESTUDT, pstrFilter As String)
    Dim lngKeep As Long
    Dim lngSwap As Long
    
    ' Find first match
    For lngKeep = 0 To UBound(ptyp)
        If ptyp(lngKeep).B = pstrFilter Then Exit For
    Next
    ' Main loop
    For lngSwap = lngKeep + 1 To UBound(ptyp)
        If ptyp(lngSwap).B <> pstrFilter Then
            ptyp(lngKeep) = ptyp(lngSwap)
            lngKeep = lngKeep + 1
        End If
    Next
    If lngKeep = 0 Then
        Erase ptyp
    ElseIf lngKeep - 1 < UBound(ptyp) Then 
        ReDim Preserve ptyp(lngKeep - 1)
    End If
End Sub

[Spoo]

Ellis Dee

LOL.. good thing I added that caveat at the end. Plus there were at
least 2 other flaws:

- Kill is a reserved VB keyword, hence not a valid variable name
- needed a "kk = kk+ 1" in the second branch as well
- ... and then, the flaw you accurately detected.

OK, here is my 2nd stab at it, and I have tested this.

It uses 2 primary branches (rather clunky) to deal with element(0)
situation. However, those branches are only hit one time, and only
1 loop is required (yeah). I'll leave it as is to convey basic concept.

    Dim aA(4)
    aA(0) = "B"
    aA(1) = "B"
    aA(2) = "1"
    aA(3) = "2"
    aA(4) = "3"
    kk = 0
    oo = 0
    tkill = "B"
    ' branch 1 - valid element 0 -- my original code 
    If Not aA(0) = tkill Then
        For ii = 0 To 4
            If aA(ii) = tkill Then
                kk = kk + 1
                aA(ii) = Empty
            ElseIf kk > 0 Then
                aA(kk) = aA(ii)
                aA(ii) = Empty
                kk = kk + 1         ' added
            End If
        Next ii
    ' branch 2 - "to be killed" element 0 -- all new
    ElseIf aA(0) = tkill Then
        For ii = 0 To 4
            If aA(ii) = tkill Then
                kk = kk + IIf(oo = 0, 0, 1)
                aA(ii) = Empty
            ElseIf aA(ii) <> tkill Then
                aA(kk + oo) = aA(ii)
                aA(ii) = Empty
                kk = kk + IIf(oo = 0, 0, 1)
                oo = 1
            End If
        Next ii
    End If

... where oo serves as a detector for first legitimate "hit"

What do I win?
Spoo

[Merri]

Spoo, you can still keep the logic simple, you just need to reconsider the order you do things:

kk = 0
kill = "B"
For ii = 0 to UBound(MyArray)
   If MyArray(ii) <> kill Then
        If kk < ii Then
            MyArray(kk) = MyArray(ii)
            MyArray(ii) = Empty
        End If
        kk = kk + 1
    Else
        MyArray(ii) = Empty
    End If
Next ii

Ellis Dee: I changed the test to ReDim a long array with 65536 items to each UDT element. Now your code runs for nearly 400 ms, where in comparison mine and LaVolpe's codes remain roughly near the same speed (LaVolpe's at some 11 ms, mine at 0.5 ms). The array size grows so big that clicking the button continuously makes computer to swap though, but that would just be an extreme example.

Edit
I shrunk the size to 128 items that is already in the area of possible use, and LaVolpe's is still nearly twice faster. 128 items in Long array = 512 bytes. So if you have any related data, you will lose performance unless you only strictly move the actual array items.