VB and VBA Users Source Code: Removing an item from a 1d array
[
Home
|
Contents
|
Search
|
Reply
| Previous |
Next
]
VB/VBA Source Code
Removing an item from a 1d array
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, May 15, 2001
Hits:
2035
Category:
Visual Basic General
Article:
Arrays are a one of the simplest ways of holding structured data and as such offer a superior performance to almost all other methods of storage. However, it is not particulary easy to manipulate data once it is stored in an array. The following code removes an item from a 1d array. Note, you can get more array handling routines from the following URL: http://www.vbusers.com/downloads/other.bas Option Explicit 'Purpose : Removes an item from a 1d array. 'Inputs : avRemoveFrom The array to remove the item from. ' [lIndex] The index of the item to remove. ' [vItemToRemove] The value of the item to remove. ' [bPreserveOrder] If True the order of the array is preserved (slightly slower) 'Outputs : Returns True if removed item from array. 'Author : Andrew Baker 'Date : 25/03/2001 'Notes : Specify EITHER the lIndex OR vItemToRemove. ' If vItemToRemove is specified and the array contains more than one item with this value, ' the first item in which matches this value will be removed. Will NOT work with fixed ' arrays (eg. Dim myArray(1 to 5) as String). Arrays must be declared as dynamic (eg. ' Dim myArray() as String). Function Array1DRemove(ByRef avRemoveFrom As Variant, Optional lIndex As Long, Optional vItemToRemove As Variant, Optional bPreserveOrder As Boolean = False) As Boolean Dim lUbound As Long, vTempVal As Variant, lLBound As Long, bFoundItem As Boolean Dim lThisItem As Long On Error GoTo ErrFailed lUbound = UBound(avRemoveFrom) lLBound = LBound(avRemoveFrom) If IsMissing(vItemToRemove) Then If lUbound >= lIndex Then 'Found item bFoundItem = True End If Else 'Remove item by value, find the item in the array For lIndex = lLBound To lUbound If avRemoveFrom(lIndex) = vItemToRemove Then 'Found item bFoundItem = True Exit For End If Next End If If bFoundItem Then 'Found item If bPreserveOrder Then 'Preserve the order of the array, 'by copying the values up the order fo the array For lThisItem = lIndex To lUbound - 1 avRemoveFrom(lThisItem) = avRemoveFrom(lThisItem + 1) Next Else 'Copy last item into a temp variable vTempVal = avRemoveFrom(lUbound) 'Overwrite item to delete avRemoveFrom(lIndex) = vTempVal End If 'Resize the array ReDim Preserve avRemoveFrom(lLBound To lUbound - 1) Array1DRemove = True End If Exit Function ErrFailed: Debug.Print Err.Description Array1DRemove = False On Error GoTo 0 End Function 'Demonstration routine Sub Test() Dim alValues() As Long, lThisItem As Long ReDim alValues(1 To 5) For lThisItem = 1 To 5 alValues(lThisItem) = lThisItem * 2 Next 'Remove item with a value 4 (preserving the order of the array) Array1DRemove alValues, , 4, True 'Remove item 1 (preserving the order of the array) Array1DRemove alValues, 1, True End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
