Pearson Software Consulting Services

    Sorting Arrays Of Objects

         The QSortInPlace procedure described on the Sorting Arrays With QSort page will sort arrays of simple data types (e.g. Strings, Integers, Longs, Singles, and Doubles). It will not sort arrays of Object type variables.  This page describes a procedure called QSortObjectsInPlace that will sort an array of objects (any type of object, including Nothing objects). Refer to the Sorting Arrays With QSort page for information about sorting arrays in general. As with QSortInPlace, QSortObjectsInPlace sorts the array that is declared in the calling procedure.  See the Passing And Returning Arrays With Functions page for information about passing arrays to functions and why InputArray is declared as a Variant rather than as an array.

The function declaration of QSortObjectsInPlace is as follows:

Public Function QSortObjectsInPlace( _
    ByRef InputArray As Variant, _
    Optional ByVal LB As Long = -1&, _
    Optional ByVal UB As Long = -1&, _
    Optional ByVal Descending As Boolean = False, _
    Optional ByVal CompareMode As VbCompareMethod = vbTextCompare, _
    Optional ByVal NoAlerts As Boolean = False, _
    Optional ByVal NoConstistancyCheck As Boolean = False) As Boolean

Here, InputArray is the array of objects to be sorted. LB and UB indicate the Lower Bound and Upper Bound index numbers of the array elements to sort, Descending indicates whether to sort in descending order, CompareMode indicates the method used in text comparison (case-sensitive or case-insensitive), and NoAlerts indicates whether to suppress error message boxes.

By default, QSortObjectsInPlace sorts the entire array. If you want to sort only part of the array, set LB to the first element index number to be sorted and set UB to the last element index number to be sorted.  In this case, only the elements between LB and UB (inclusive) will be sorted. The elements before LB and after UB will be left in their original order.  If LB is omitted or is less than 0, it is set to the LBound of InputArray and sorting begins at the first element of the array. If UB is omitted or is less than 0, it is set to the UBound of InputArray and sorting ends at the last element of the array. To sort the entire array, omit the LB and UB paramters, set both to -1, or set LB to LBound(InputArray) and set UB to UBound(InputArray).

By default, QSortObjectsInPlace will test to see that all objects in the InputArray are of the same object type.  If they have different type names, an error will occurs If you are sure that all your objects are of the same type (or Nothing), or you have written the QSortObjectCompare procedure (see below) to handle multiple object types, you can skip the object consistency check by setting the NoConsistancy
You must supply a function called  QSortObjectCompare that is used to compare two objects in the array. The function must be declared as follows:

Function QSortObjectCompare(Obj1 As Variant, Obj2 As Variant, _
    Optional CompareMode As VbCompareMethod = vbTextCompare) As Long

This function should return -1 if Obj1 is "less than" Obj2, 0 if Obj1 "equals" Obj2, and +1 if Obj1 is "greater than" Obj2.  It is up to you to determine what the meaning of "less than", "equal to", and "greater than" is in the context of the objects being sorted. For example, if you have an array containing references to Excel worksheets, it is up to you to determine what attribute of one worksheet makes it "less than" another worksheet. This could be the value of a particular cell on the sheet, or the sheet name, or any other property of a worksheet.  There is no general definition that defines one object as being less than another object of the same type.

The QSortObjectCompare procedure should consider an object that is Nothing to be less than any other object of any type and less than a non-Object variables. That is to say, an object that is Nothing is less than any variable or object of any type. Nothing is less than everything.  An example QSortObjectCompare is described on the QSortObjectCompare page.

The code for QSortObjectsInPlace and required supporting procedures is shown below. You can download this file that contains the module modQSortObjectsInPlace, containing the code below, and the module modQSortObjectCompare, containing an example QSortObjectCompare function. This function is described on the QSortObjectCompare page

You can download an full workbook with test code here, or  download the code here. This download contains the code below and an example QSortObjectCompare procedure.

Option Explicit
Option Compare Text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modQSortObjectsInPlace
' By Chip Pearson, www.cpearson.com, chip@cpearson.com
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This module contains the QSortObjectsInPlace procedure and private supporting procedures.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function QSortObjectsInPlace( _
    ByRef InputArray As Variant, _
    Optional ByVal LB As Long = -1&, _
    Optional ByVal UB As Long = -1&, _
    Optional ByVal Descending As Boolean = False, _
    Optional ByVal CompareMode As VbCompareMethod = vbTextCompare, _
    Optional ByVal NoAlerts As Boolean = False, _
    Optional ByVal NoConstistencyCheck As Boolean = False) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' QSortObjectsInPlace
'
' This function sorts the array InputArray in place -- this is, the original array in the
' calling procedure is sorted. InputArray must be an array of Objects or Variants containing
' Objects. An error will occur if an element of the array is not an Object. (Objects that
' are Nothing are acceptable.)
'
' It need not sort the entire array. You can sort only part of the array by setting the LB and
' UB parameters to the first (LB) and last (UB) element indexes that you want to sort.
' LB and UB are optional parameters. If omitted LB is set to the LBound of InputArray, and if
' omitted UB is set to the UBound of the InputArray. If you want to sort the entire array,
' omit the LB and UB parameters, or set both to -1, or set LB = LBound(InputArray) and set
' UB to UBound(InputArray).
'
' By default, the procedure tests the InputArray to ensure that all of the objects in the
' InputArray are of the same object type (or Nothing -- Nothing objects are allowed in the
' sort). If you are SURE(!) that the array will contain the same types of objects, or you have written
' the QSortObjectCompare procedure (see below) to handle different object types, you can skip the array
' consistency check by setting the NoConstistencyCheck parameter to True (the default is False).
'
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' The QSortObjectCompare Procedure To Compare Two Objects
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' You must create a function named QSortObjectCompare that accepts two Objects, compares
' them in a manner suitable for the given type of object, and returns the result of
' the comparison. The declaration of the function you supply is:
'
'   Function QSortObjectCompare(Obj1 As Variant, Obj2 As Variant, _
'           CompareMode As VbCompareMethod) As Long
'
' The function QSortObjectCompare should return:
'       -1 if Obj1 is "less than" Obj2
'        0 if Obj1 is "equal to" Obj2
'       +1 if Obj1 is "greater than" Obj2
'
' Of course, the meaning of "less than", "equal to", and "greater than" will depend
' on the object type in the array. It is the responsibility of the QSortObjectCompare
' function of determine what constitutes the relationship between the two objects
' passed to it.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MODIFYING THIS CODE:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You can modify this code to meet your needs, although since it can handle
' any type of object, this likely isn't necessary. If you are going to use this
' code to sort only one type and one type only of object, and you know when writing the
' code what type of object that will be (e.g., always arrays of ranges), you can
' change the declarations from "As Object" to "As YourObjectType". This will improve
' the performace of the sort. If your code calls Exit Function, you MUST decrement
' the RecursionLevel variable before exiting the code. E.g,
'       If SomethingThatCausesAnExit Then
'           RecursionLevel = RecursionLevel - 1
'           Exit Function
'       End If
'
' If you don't decrement the RecursionLevel variable, the code will not perform as
' expected on subsequent calls.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' The QSortObjectCompare procedure should consider an object that is Nothing to be
' less than any object of any type that is not Nothing. Note that you cannot abort the
' sort process once it has started.
'
' If you add code that will cause an Exit Function
' after the sort process has started, the order of the elements in the array will
' be undefined.
'
' You should check the integrity of the array (e.g,. ensuring all objects are the same
' type or not Nothing, if required) prior to calling this procedure.
'
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'
' The function returns TRUE if the array was successfully sorted or FALSE if an error
' occurred. If an error occurs (e.g., LB > UB), a message box indicating the error is
' displayed. To suppress message boxes, set the NoAlerts parameter to TRUE.
'
' Note: If you coerce InputArray to a ByVal argument, QSortObjectsInPlace will not be
' able to reference the InputArray in the calling procedure and the array will
' not be sorted.
'
' This function uses the following procedures. These are declared as Private procedures
' at the end of this module:
'       IsArrayAllocated
'       NumberOfArrayDimensions
'       ReverseObjectArrayInPlace
'
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Temp As Object
Dim Buffer As Object
Dim CurLow As Long
Dim CurHigh As Long
Dim CurMidpoint As Long
Dim Ndx As Long
Dim pCompareMode As VbCompareMethod
Dim ObjectTypeName As String

'''''''''''''''''''''''''
' Set the default result.
'''''''''''''''''''''''''
QSortObjectsInPlace = False

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This variable is used to determine the level
' of recursion  (the function calling itself).
' RecursionLevel is incremented when this procedure
' is called, either initially by a calling procedure
' or recursively by itself. The variable is decremented
' when the procedure exits. We do the input parameter
' validation only when RecursionLevel is 1 (when
' the function is called by another function, not
' when it is called recursively).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Static RecursionLevel As Long

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Keep track of the recursion level -- that is, how many
' times the procedure has called itself.
' Carry out the validation routines only when this
' procedure is first called. Don't run the
' validations on a recursive call to the
' procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
RecursionLevel = RecursionLevel + 1

If RecursionLevel = 1 Then
    ''''''''''''''''''''''''''''''''''
    ' Ensure InputArray is an array.
    ''''''''''''''''''''''''''''''''''
    If IsArray(InputArray) = False Then
        If NoAlerts = False Then
            MsgBox "The InputArray parameter is not an array."
        End If
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' InputArray is not an array. Exit with a False result.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        RecursionLevel = RecursionLevel - 1
        Exit Function
    End If
                
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Test LB and UB. If < 0 then set to LBound and UBound
    ' of the InputArray.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If LB < 0 Then
        LB = LBound(InputArray)
    End If
    If UB < 0 Then
        UB = UBound(InputArray)
    End If
    
    Select Case NumberOfArrayDimensions(InputArray)
        Case 0
            ''''''''''''''''''''''''''''''''''''''''''
            ' Zero dimensions indicates an unallocated
            ' dynamic array.
            ''''''''''''''''''''''''''''''''''''''''''
            If NoAlerts = False Then
                MsgBox "The InputArray is an empty, unallocated array."
            End If
            RecursionLevel = RecursionLevel - 1
            Exit Function
        Case 1
            ''''''''''''''''''''''''''''''''''''''''''
            ' We sort ONLY single dimensional arrays.
            ''''''''''''''''''''''''''''''''''''''''''
        Case Else
            ''''''''''''''''''''''''''''''''''''''''''
            ' We sort ONLY single dimensional arrays.
            ''''''''''''''''''''''''''''''''''''''''''
            If NoAlerts = False Then
                MsgBox "The InputArray is multi-dimensional." & _
                      "QSortInPlace works only on single-dimensional arrays."
            End If
            RecursionLevel = RecursionLevel - 1
            Exit Function
    End Select
    
    ''''''''''''''''''''''''''''''''''''''
    ' Ensure every element of the array is
    ' an object.
    ''''''''''''''''''''''''''''''''''''''
    For Ndx = LBound(InputArray) To UBound(InputArray)
        If IsObject(InputArray(Ndx)) = False Then
            If NoAlerts = False Then
                MsgBox "Element " & CStr(Ndx) & " of InputArray is not an object."
            End If
            RecursionLevel = RecursionLevel - 1
            Exit Function
        End If
    Next Ndx
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ensure that the LB parameter is valid.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    Select Case LB
        Case Is < LBound(InputArray)
            If NoAlerts = False Then
                MsgBox "The LB lower bound parameter is less than the LBound of the InputArray"
            End If
            RecursionLevel = RecursionLevel - 1
            Exit Function
        Case Is > UBound(InputArray)
            If NoAlerts = False Then
                MsgBox "The LB lower bound parameter is greater than the UBound of the InputArray"
            End If
            RecursionLevel = RecursionLevel - 1
            Exit Function
        Case Is > UB
            If NoAlerts = False Then
                MsgBox "The LB lower bound parameter is greater than the UB upper bound parameter."
            End If
            RecursionLevel = RecursionLevel - 1
            Exit Function
    End Select

    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ensure the UB parameter is valid.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    Select Case UB
        Case Is > UBound(InputArray)
            If NoAlerts = False Then
                MsgBox "The UB upper bound parameter is greater than the upper bound of the InputArray."
            End If
            RecursionLevel = RecursionLevel - 1
            Exit Function
        Case Is < LBound(InputArray)
            If NoAlerts = False Then
                MsgBox "The UB upper bound parameter is less than the lower bound of the InputArray."
            End If
            RecursionLevel = RecursionLevel - 1
            Exit Function
        Case Is < LB
            If NoAlerts = False Then
                MsgBox "the UB upper bound parameter is less than the LB lower bound parameter."
            End If
            RecursionLevel = RecursionLevel - 1
            Exit Function
    End Select

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Ensure that all the elements of InputArray are of the
    ' same object type (or Nothing). Note that this uses
    ' TypeName to compare object types. It is possible that
    ' that the array might contain two different objects
    ' that have the same TypeName (e.g, an Excel.Range object
    ' and a Word.Range object both return "Range" as the TypeName).
    ' There is no way to test for this condition and the array
    ' will pass this test even though it contains objects of
    ' different types whose TypeName is the same.
    ' If you are sorting objects with multiple interfaces
    ' (e.g, an array of Userforms), you should set NoConstistencyCheck
    ' to True. Otherwise the array will be considered inconsistent
    ' (e.g., the TypeName of a userform is the name of the form --
    ' Userform1 or Userform2 -- not a generic MSForms.UserForm.
    '
    ' You can skip the object-constancy test by setting the
    ' NoConstistencyCheck parameter to this procedure to True
    ' (the default is False = check for constistency). If
    ' you set NoConstistencyCheck to True, the array might
    ' contain objects of different types (e.g., Excel Ranges
    ' mixed in with custom classes mixed in with Worksheet
    ' references). If you set NoConstistencyCheck to True, you
    ' must be sure before calling this procedure that the
    ' array is of all one type of object, and/or write your
    ' QSortObjectCompare procedure to handle objects of
    ' varying types (it will have to be able to compare, say,
    ' an Excel Range object and a Worksheet object and somehow
    ' determine which object is "less than" the other).
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If NoConstistencyCheck = False Then
        For Ndx = LBound(InputArray) To UBound(InputArray)
            If ObjectTypeName = vbNullString Then
                If Not InputArray(Ndx) Is Nothing Then
                    ObjectTypeName = TypeName(InputArray(Ndx))
                End If
            Else
                If Not InputArray(Ndx) Is Nothing Then
                    If TypeName(InputArray(Ndx)) <> ObjectTypeName Then
                        If NoAlerts = False Then
                            MsgBox "Inconstistnt object types found."
                        End If
                        RecursionLevel = RecursionLevel - 1
                        Exit Function
                    End If
                End If
            End If
        Next Ndx
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' if UB = LB, we have nothing to sort, so get out.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If UB = LB Then
        RecursionLevel = RecursionLevel - 1
        Exit Function
    End If

End If ' RecursionLevel = 1

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure that CompareMode is either vbBinaryCompare  or
' vbTextCompare. If it is neither, default to vbTextCompare.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If (CompareMode = vbBinaryCompare) Or (CompareMode = vbTextCompare) Then
    pCompareMode = CompareMode
Else
    pCompareMode = vbTextCompare
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Begin the actual sorting process.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

CurLow = LB
CurHigh = UB

CurMidpoint = (LB + UB) \ 2 ' note integer division (\) here

Set Temp = InputArray(CurMidpoint)

Do While (CurLow <= CurHigh)
    
    Do While QSortObjectCompare(InputArray(CurLow), Temp, pCompareMode) < 0
        CurLow = CurLow + 1
        If CurLow = UB Then
            Exit Do
        End If
    Loop
    
    Do While QSortObjectCompare(Temp, InputArray(CurHigh), pCompareMode) < 0
        CurHigh = CurHigh - 1
        If CurHigh = LB Then
           Exit Do
        End If
    Loop

    If (CurLow <= CurHigh) Then
        Set Buffer = InputArray(CurLow)
        Set InputArray(CurLow) = InputArray(CurHigh)
        Set InputArray(CurHigh) = Buffer
        CurLow = CurLow + 1
        CurHigh = CurHigh - 1
    End If
Loop

If LB < CurHigh Then
    QSortObjectsInPlace InputArray:=InputArray, LB:=LB, UB:=CurHigh, _
        Descending:=Descending, CompareMode:=pCompareMode, NoAlerts:=True
End If

If CurLow < UB Then
    QSortObjectsInPlace InputArray:=InputArray, LB:=CurLow, UB:=UB, _
        Descending:=Descending, CompareMode:=pCompareMode, NoAlerts:=True
End If

'''''''''''''''''''''''''''''''''''''
' If Descending is True, reverse the
' order of the array, but only if the
' recursion level is 1.
'''''''''''''''''''''''''''''''''''''
If Descending = True Then
    If RecursionLevel = 1 Then
        ReverseObjectArrayInPlace InputArray, False
    End If
End If

RecursionLevel = RecursionLevel - 1
QSortObjectsInPlace = True

End Function


Private Function IsArrayAllocated(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayAllocated
' Returns TRUE if the array is allocated (either a static array or a dynamic array that has been
' sized with Redim) or FALSE if the array has not been allocated (a dynamic that has not yet
' been sized with Redim, or a dynamic array that has been Erased).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim N As Long

'''''''''''''''''''''''''''''''''''''''''''''''''''
' If Arr is not an array, return FALSE and get out.
'''''''''''''''''''''''''''''''''''''''''''''''''''
If IsArray(Arr) = False Then
    IsArrayAllocated = False
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Try to get the UBound of the array. If the array has not been allocated,
' an error will occur. Test Err.Number to see if an error occured.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
N = UBound(Arr, 1)
If Err.Number = 0 Then
    '''''''''''''''''''''''''''''''''''''
    ' No error. Array has been allocated.
    '''''''''''''''''''''''''''''''''''''
    IsArrayAllocated = True
Else
    '''''''''''''''''''''''''''''''''''''
    ' Error. Unallocated array.
    '''''''''''''''''''''''''''''''''''''
    IsArrayAllocated = False
End If

End Function


Private Function NumberOfArrayDimensions(Arr As Variant) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NumberOfArrayDimensions
' This function returns the number of dimensions of an array. An unallocated dynamic array
' has 0 dimensions. This condition can also be tested with IsArrayEmpty.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
' Loop, increasing the dimension index Ndx, until an error occurs.
' An error will occur when Ndx exceeds the number of dimension
' in the array. Return Ndx - 1.
Do
    Ndx = Ndx + 1
    Res = UBound(Arr, Ndx)
Loop Until Err.Number <> 0

NumberOfArrayDimensions = Ndx - 1

End Function


Private Function ReverseObjectArrayInPlace(ByRef InputArray As Variant, _
    Optional NoAlerts As Boolean = False) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ReverseObjectArrayInPlace
' This reverses the order of objects in an array of objects in place. That
' is, the array in the calling procedure is reversed.
'
' This procedure returns True if the array was successfully reversed, or
' False if an error occurred.

' If an error occurs, a message box is displayed indicating the
' error. To suppress the display of message boxes, set the
' NoAlerts parameter to True.
'
' This procedure uses the following procedures, which are declared
' as Private procedures at the end of this module:
'       NumberOfArrayDimensions
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Temp As Object
Dim Ndx As Long
Dim Ndx2 As Long

''''''''''''''''''''''''''''''''
' Set the default return value.
''''''''''''''''''''''''''''''''
ReverseObjectArrayInPlace = False

'''''''''''''''''''''''''''''''''
' Ensure we have an array
'''''''''''''''''''''''''''''''''
If IsArray(InputArray) = False Then
    If NoAlerts = False Then
        MsgBox "The InputArray parameter is not an array."
    End If
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''
' Test the number of dimensions of the
' InputArray. If 0, we have an empty,
' unallocated array. Get out with
' an error message. If greater than
' one, we have a multi-dimensional
' array, which is not allowed. Only
' an allocated 1-dimensional array is
' allowed.
''''''''''''''''''''''''''''''''''''''
Select Case NumberOfArrayDimensions(InputArray)
    Case 0
        '''''''''''''''''''''''''''''''''''''''''''
        ' Zero dimensions indicates an unallocated
        ' dynamic array.
        '''''''''''''''''''''''''''''''''''''''''''
        If NoAlerts = False Then
            MsgBox "The input array is an empty, unallocated array."
        End If
        Exit Function
    Case 1
        '''''''''''''''''''''''''''''''''''''''''''
        ' OK.
        '''''''''''''''''''''''''''''''''''''''''''
    Case Else
        '''''''''''''''''''''''''''''''''''''''''''
        ' We can reverse ONLY a single dimensional
        ' arrray.
        '''''''''''''''''''''''''''''''''''''''''''
        If NoAlerts = False Then
            MsgBox "The input array multi-dimensional. ReverseArrayInPlace works only " & _
                   "on single-dimensional arrays."
        End If
        Exit Function
End Select

''''''''''''''''''''''''''''''''''''
' Ensure that each element in the
' InputArray is in fact an object.
''''''''''''''''''''''''''''''''''''
For Ndx = LBound(InputArray) To UBound(InputArray)
    If IsObject(InputArray(Ndx)) = False Then
        If NoAlerts = False Then
            MsgBox "Element " & CStr(Ndx) & " of the InputArray is not an object."
        End If
        Exit Function
    End If
Next Ndx

Ndx2 = UBound(InputArray)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' loop from the LBound of InputArray to the midpoint of InputArray.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Ndx = LBound(InputArray) To ((UBound(InputArray) - LBound(InputArray) + 1) \ 2)
    '''''''''''''''''''''''''''''''''
    'swap the elements
    '''''''''''''''''''''''''''''''''
    Set Temp = InputArray(Ndx)
    Set InputArray(Ndx) = InputArray(Ndx2)
    Set InputArray(Ndx2) = Temp
    '''''''''''''''''''''''''''''
    ' decrement the upper index
    '''''''''''''''''''''''''''''
    Ndx2 = Ndx2 - 1
Next Ndx

ReverseObjectArrayInPlace = True

End Function


	

 

 

     
     

 

Created By Chip Pearson and Pearson Software Consulting, LLC 
This Page:                Updated: November 06, 2013     
MAIN PAGE    About This Site    Consulting    Downloads  
Page Index     Search    Topic Index    What's New   
Links   Legalese And Disclaimers
chip@cpearson.com

© Copyright 1997-2007  Charles H. Pearson