Printable View
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.
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:
Code: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
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.
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).
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:Quote:
Originally Posted by BruceG
Quote:
The actual arrays are udts, so I can't use the native Filter() command or anything like it.
Sorting touches each element way more than once, so it would be less efficient to sort it just for this.Quote:
Originally Posted by LaVolpe
The array is actually already sorted, but it's sorted on a different column.
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.
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.
They get permanently deleted, and the order is important.
His solution is highly inefficient; way too inefficient for my needs.Quote:
Originally Posted by LaVolpe
Try this. The important code is between the dashed lines. If you need clarification on anything, ask.
Code: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
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.
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:Quote:
Originally Posted by LaVolpe
myUDT(Index) = myUDT(Count)
The problem is that it's unstable. The original order needs to be preserved.
Yeah, no kidding. But I can't use recordsets for this particular project, so please take your witnessing elsewhere.Quote:
Originally Posted by dilettante
It's unstable because one counter is starting at the end and one from the beginning. They both have to start at the beginning.Quote:
Originally Posted by 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.
Option 1 is what I'm looking for. It will be much more efficient than Option 2.Quote:
Originally Posted by LaVolpe
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.
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:
Code: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
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.
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.Quote:
Originally Posted by Ellis Dee
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.
Your other posts, your examples did not show the array in sorted order
If the array is sorted as shown in your last posting, then it is easy, no?Quote:
Originally Posted by Ellis Dee
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
Code: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
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.
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.Code: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
This would be an interesting contest to see what method is the fastest.
You said (in post #11) that sample code I posted is "highly inefficient" but how is what you've done different? :confused: :confused: :confused:Quote:
Originally Posted by Ellis Dee
without meaning to be rude Rhino have you properly compared the two pieces of code, they are very 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.Quote:
Originally Posted by RhinoBull
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.
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.
Fair point. It would be interesting to see a benchmark, but I suspect that the results will vary wildly depending on the input.
I did something that works just for string arrays; didn't bother to start figuring out a good way to work with UDTs.
Sample:Code: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
Code: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
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.
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.
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!
Ellis Dee
Already resolved, I know, but here's my 2 cents...
Hopefully you'd end up with...Code: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
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
Yeah, pretty much what I expected. Nice benchmark, thanks.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.Quote:
Originally Posted by Merri
Even with very long strings, as soon as the number of array elements grows my method outperforms both of his.
Close; that's the idea I was going for. The specifics of your logic appear flawed, but the concept is correct.Quote:
Originally Posted by Spoo
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:vb Code:
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:Code: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
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.
... where oo serves as a detector for first legitimate "hit"Code: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
What do I win?
Spoo
Spoo, you can still keep the logic simple, you just need to reconsider the order you do things:Code: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.
That's the code I was looking for in the OP. I don't see a need to zero out deleted values, though, since they'll either get overwritten or redimmed into the void.Quote:
Originally Posted by Merri
Code:Private Sub FilterUDT(ptyp() As TESTUDT, pstrFilter As String)
Dim lngKeep As Long
Dim lngSwap As Long
For lngSwap = 0 To UBound(ptyp)
If ptyp(lngSwap).B <> pstrFilter Then
If lngKeep < lngSwap Then ptyp(lngKeep) = ptyp(lngSwap)
lngKeep = lngKeep + 1
End If
Next
Select Case lngKeep
Case 0: Erase ptyp
Case Is <= UBound(ptyp): ReDim Preserve ptyp(lngKeep - 1)
End Select
End Sub
Yeah, that's tight. A nice combination of simplicity and efficiency.
There is just one problem: when you Erase an array in function, it may cause major problems in the code that assumes the array remains in place. This would force you to consider using an API to resize the array so that you can have a valid array of 0 elements instead of a null array:I included the earlier tight code into the test project.Code:Private Sub FilterUDT_tight2(ptyp() As TESTUDT, pstrFilter As String)
Dim lngKeep As Long
Dim lngSwap As Long
Dim lngReDim(0 To 1) As Long
For lngSwap = 0 To UBound(ptyp)
If ptyp(lngSwap).B <> pstrFilter Then
If lngKeep < lngSwap Then ptyp(lngKeep) = ptyp(lngSwap)
lngKeep = lngKeep + 1
End If
Next
lngReDim(0) = lngKeep
SafeArrayRedim Not Not ptyp, lngReDim(0)
Debug.Assert App.hInstance
End Sub
Private Declare Function SafeArrayRedim Lib "oleaut32" (ByVal saPtr As Long, saBound As Long) As Long
I'm happy with the performance of the non-API version, especially the single loop method you posted. Seems so simple looking at it now, but I just couldn't figure it out. You rock.Quote:
Originally Posted by Merri
I do have related data, though I'm not sure if it's how you mean. My app has three normalized tables, so I do need to do cascade deletions. I have some rather odd requirements:
1) No installation allowed, so I can't use dependencies.
2) Data file, which contains all three tables in a single file, must remain smaller than 50k unzipped.
3) Compiled exe must zip to < 50k
Due to 1) and 2) I can't use recordsets. Due to 3) I really can't use either of the faster methods since there is so much more code involved. Note that because they are udts, I need three copies of this function; one for each table. (udt array) The exe currently zips down to 38k, and I have some more stuff to add, so this most recent 15-line version is perfect. Kind of reminds me of the old C days under DOS and worrying about memory models.
Since the datasize must remain so small, the system archives any data older than 10 days. That means the 15-liner will be lightning fast for my needs.
What code would assume the array remains in place?Quote:
Originally Posted by Merri
If the next line outside procedure calls UBound you will get an error if the array has been Erased.
Oh, I thought you meant "in place" as in it still resides in the same block of memory. You mean "in place" as in there is an actual array.
Yeah, I'm aware of the issues of dealing with uninitialized arrays. I maintain the UBound of the three tables in module-level "property" variables, which get set to -1 when their associated arrays are unintialized. (Though I handle the data in bas modules, the module-level variables are treated like property variables.)