Visual Basic Library

This page was last updated on Saturday, November 24, 2001
Public Function AllButValues(intItemList() As Integer, intI As Integer, intv As Integer)
' Procedure :   AllBut
' Description:  Reduce a list by one element identified as a pair of values
' By:           Chris Greaves Inc.
' Inputs:       Array of items to fit, pair describing an element.
' Returns:      None.
' Assumes:      The items exist within the source array
' Side Effects: None.
' Tested:       By the calls shown below.
' Method: I loop through the source array until I locate the item to be deleted,
'   then I copy the last item of the source array over the located item.
'   In this way only one elelement has to be copied and the loop can terminate immediately.
' In this implementation the onus is on the user to redimension the array, (as shown in the test macro)
'   so that the last elelement (which was copied over the identified element) can be dropped.
    Dim intJ As Integer
    ' We need loop only to the penultimate entry,
    '   since if that were the element to be ropepd we'd drop it by default.
    '   (see the Assumptions above)
    For intJ = 0 To UBound(intItemList, 2) - 1
        If (intI = intItemList(0, intJ)) Then
            If (intv = intItemList(1, intJ)) Then
                ' move the end item over this item
                intItemList(0, intJ) = intItemList(0, UBound(intItemList, 2))
                intItemList(1, intJ) = intItemList(1, UBound(intItemList, 2))
                Exit For
            Else
            End If
        Else
        End If
    Next intJ
'Sub TESTAllButValues()
'Dim intItemList() As Integer
'ReDim intItemList(1, 3)
'intItemList(0, 0) = 1
'intItemList(0, 1) = 2
'intItemList(0, 2) = 3
'intItemList(0, 3) = 4
'intItemList(1, 0) = 10
'intItemList(1, 1) = 20
'intItemList(1, 2) = 30
'intItemList(1, 3) = 40
'Call AllButValues(intItemList, 2, 20)
'MsgBox intItemList(1, 0) '10
'MsgBox intItemList(1, 1) '40
'MsgBox intItemList(1, 2) '30
'MsgBox intItemList(1, 3) '40
'ReDim Preserve intItemList(UBound(intItemList, 1), UBound(intItemList, 2) - 1)
'MsgBox intItemList(1, 0) '10
'MsgBox intItemList(1, 1) '40
'MsgBox intItemList(1, 2) '30
'End Sub
End Function