Visual Basic Programming Code Examples

Visual Basic > Other Code Examples

Moving items in collections



Moving items in collections

The following code shows how to move/swap items in a collection.

Option Explicit


'Purpose     :  Moves an item in a collection.
'Inputs      :  colMoveItem                 The collection to move the item in.
'               vItem                       The item index or tag of the item to move.
'               vMoveToItem                 The item or tag of the item to move to.
'               [bMoveBefore]               If True moves item vItem before vMoveToItem, else
'                                           moves the item vItem after vMoveToItem.

'Outputs     :  Returns True if it successfully moves the item.
'Notes       :  Item tags will be lost if moving items by index.


Private Function CollectionMoveItem(colMoveItem As Collection, vItem As Variant, vMoveToItem As Variant, Optional bMoveBefore As Boolean = True) As Boolean
    Dim vItemIndexMoveTo As Variant, vItemIndexExisting As Variant
    Dim lStartPos As Long, lThisItem As Long, lEndPos As Long
    
    On Error GoTo ErrFailed
    If vItem <> vMoveToItem Then
        'Get a reference to the item to move
        If CollectionGetItem(colMoveItem, vItem, vItemIndexExisting) Then
            'Get a reference to the item to move to
            If CollectionGetItem(colMoveItem, vMoveToItem, vItemIndexMoveTo) Then
                'Remove the item to move
                If VarType(vItem) = vbString Then
                    colMoveItem.Remove CStr(vItem)
                Else
                    colMoveItem.Remove CLng(vItem)
                End If
                'Add the item to move back into the collection
                If VarType(vMoveToItem) = vbString Then
                    'Move items using Tags
                    If bMoveBefore Then
                        colMoveItem.Add vItemIndexExisting, CStr(vItem), CStr(vMoveToItem)
                    Else
                        colMoveItem.Add vItemIndexExisting, CStr(vItem), , CStr(vMoveToItem)
                    End If
                Else
                    'Move an item near an item, based on an index
                    If bMoveBefore Then
                        If vMoveToItem < vItem Then
                            colMoveItem.Add vItemIndexExisting, , CLng(vMoveToItem)
                        Else
                            'We have removed item vItem which is below the vMoveToItem index, so
                            'we have to subtract one from the vMoveToItem index
                            colMoveItem.Add vItemIndexExisting, , CLng(vMoveToItem) - 1
                        End If
                    Else
                        If vMoveToItem < vItem Then
                            colMoveItem.Add vItemIndexExisting, , , CLng(vMoveToItem)
                        Else
                            'We have removed item vItem which is below the vMoveToItem index, so
                            'we have to subtract one from the vMoveToItem index
                            colMoveItem.Add vItemIndexExisting, , , CLng(vMoveToItem) - 1
                        End If
                    End If
                End If
                CollectionMoveItem = True
            End If
        End If
    End If
    Exit Function
    
ErrFailed:
    Debug.Print "Error in CollectionMoveItem: " & Err.Description
    CollectionMoveItem = False
End Function

'Purpose     :  Finds and returns an item in a collection.
'Inputs      :  colGetItem                  The collection to find the item in.
'               vItem                       The key or index of the item.
'               [vItemFound]                See outputs.
'Outputs     :  Returns True if it successfully finds the item.
'               [vItemFound]                The item found in the collection.


Private Function CollectionGetItem(colGetItem As Collection, vItem As Variant, Optional vItemFound As Variant) As Boolean
    On Error GoTo ErrFailed
    'Get a reference to the item to move
    If VarType(vItem) = vbString Then
        If VarType(colGetItem.Item(CStr(vItem))) = vbObject Then
            Set vItemFound = colGetItem.Item(CStr(vItem))
        Else
            vItemFound = colGetItem.Item(CStr(vItem))
        End If
    Else
        If VarType(colGetItem.Item(CLng(vItem))) = vbObject Then
            Set vItemFound = colGetItem.Item(CLng(vItem))
        Else
            vItemFound = colGetItem.Item(CLng(vItem))
        End If
    End If
    CollectionGetItem = True
    Exit Function
    
ErrFailed:
    CollectionGetItem = False
    Debug.Print "Error in CollectionGetItem: " & Err.Description
End Function


Sub Test()
    Dim colAlphabet As Collection, lThisChar As Long
    Set colAlphabet = New Collection
    For lThisChar = 65 To 90
        colAlphabet.Add Chr$(lThisChar), Chr$(lThisChar)
    Next
    CollectionMoveItem colAlphabet, "A", "Z"        'Move the item A before Z
    CollectionMoveItem colAlphabet, 1, 2, False     'Move the item 1 before 2 (swap B and C)
End Sub