[digioz]

Hi All,

A short while ago I was looking for a simple way to sort a collection in VB.NET. I finally found the subroutine I was looking for today and figured other people can use it as well. The following subroutine will sort objects residing in a collection by a property you specify in either ascending or descending order:

For collections (special thanks to Greg Givler's post on FreeVBCode.com):

Code:

 
Public Sub SortCollection(col As Collection, _
  psSortPropertyName As String, pbAscending As Boolean, _
   Optional psKeyPropertyName As String = "")
	
		Dim obj As Object
		Dim i As Integer
		Dim j As Integer
		Dim iMinMaxIndex As Integer
		Dim vMinMax As Object
		Dim vValue As Object
		Dim bSortCondition As Boolean
		Dim bUseKey As Boolean
		Dim sKey As String
	
			bUseKey = (psKeyPropertyName <> "")
	
			For i = 1 To col.Count - 1
				obj = col(i)
				' the vbGet can be replaced with a 
				 'CallType.Get if you
				' want. See VB Language reference for CallByName
		
			vMinMax = CallByName(obj, psSortPropertyName, VbGet)
				iMinMaxIndex = i
	
				For j = i + 1 To col.Count
					obj = col(j)
					vValue = CallByName(obj, _
						psSortPropertyName, VbGet)
	
					If (pbAscending) Then
						bSortCondition = (vValue < vMinMax)
					Else
						bSortCondition = (vValue > vMinMax)
					End If
	
					If (bSortCondition) Then
						vMinMax = vValue
						iMinMaxIndex = j
					End If
	
					obj = Nothing
				Next j
	
				If (iMinMaxIndex <> i) Then
					obj = col(iMinMaxIndex)
	
					col.Remove(iMinMaxIndex)
					If (bUseKey) Then
						sKey = CStr(CallByName(obj, _
						   psKeyPropertyName, VbGet))
						col.Add(obj, sKey, i)
					Else
						col.Add(obj, , i)
					End If
	
					obj = Nothing
				End If
	
				obj = Nothing
			Next i
	
	End Sub
 
' Sample use: 
SortCollection(collection, "EmployeeName", True)

Here is a similar subroutine for an ArrayList (forgot where I found this one):

Code:

 
Public Sub SortObjectCol(ByVal List As ArrayList, ByVal min As 
Integer, _
		ByVal max As Integer, ByVal propName As String)
		Dim last_swap As Integer
		Dim i As Integer
		Dim j As Integer
		Dim tmp As Object

		' Repeat until we are done.
		Do While min < max
			' Bubble up.
			last_swap = min - 1
			' For i = min + 1 To max
			i = min + 1
			Do While i <= max
				' Find a bubble.
				If CallByName(List(i - 1), propName, CallType.Get) > 
CallByName(List(i), propName, CallType.Get) Then
					' See where to drop the bubble.
					tmp = List(i - 1)
					j = i
					Do
						List(j - 1) = List(j)
						j = j + 1
						If j > max Then Exit Do
					Loop While CallByName(List(j), propName, 
CallType.Get) < CallByName(tmp, propName, CallType.Get)
					List(j - 1) = tmp
					last_swap = j - 1
					i = j + 1
				Else
					i = i + 1
				End If
			Loop
			' Update max.
			max = last_swap - 1

			' Bubble down.
			last_swap = max + 1
			' For i = max - 1 To min Step -1
			i = max - 1
			Do While i >= min
				' Find a bubble.
				If CallByName(List(i + 1), propName, CallType.Get) < 
CallByName(List(i), propName, CallType.Get) Then
					' See where to drop the bubble.
					tmp = List(i + 1)
					j = i
					Do
						List(j + 1) = List(j)
						j = j - 1
						If j < min Then Exit Do
					Loop While CallByName(List(j), propName, 
CallType.Get) > CallByName(tmp, propName, CallType.Get)
					List(j + 1) = tmp
					last_swap = j + 1
					i = j - 1
				Else
					i = i - 1
				End If
			Loop
			' Update min.
			min = last_swap + 1
		Loop
	End Sub


	'sample use syntax
	'SortObjectCol(col, 0, col.Count - 1, "ID")

i know this an old thread but thanks digi, i just stumbled across it in a search and it was exactly what i needed.

[digioz]

You are very welcome bud.

[levienigma]

I came across your thread and it has been what I been trying do, thank you. Im still new to .net, and I have a little problem with how to make it work
I have placed this part of code in my button but I replaced "col" with
SortObjectCol(al3, 0, al3.Count - 1, "tax_id")

al3 is my arraylist and I want to sort on "tax_id" but I keep getting an error
I want to sort off datatype "tax_id" can you please help. Thank you

'sample use syntax
'SortObjectCol(col, 0, col.Count - 1, "ID")

[levienigma]

Also it seem that my application is getting stuck in a continued loop when it hits the sort and i dont understand why

[digioz]

Wow! Its been a while since I posted this code (about 4 years to be exact). But I think this topic is important enough to be worthy of further clarification.

I am attaching a sample VS 2005 VB.NET Project to this post. Here is how the sample form looks:

Sorting_Collection_and_ArrayList_1.jpg

Lets say you have a class called "MyData" which holds your actual Data Object:

Public Class MyData
        Private m_Value As String
        Public Property Value() As String
            Get
                Return m_Value
            End Get
            Set(ByVal value As String)
                m_Value = value
            End Set
        End Property
    End Class 

Here are the two functions I wrote to create an arraylist and a collection respectively from the data in the textbox on the form (one item per line):

Public Function ToArrayList(ByVal lsString As String) As ArrayList
        Dim laListItems As Array = Split(lsString, vbNewLine)
        Dim laListItems2 As New ArrayList
        Dim loMyData As MyData
        Dim i As Integer
        For i = 0 To laListItems.Length - 1
            loMyData = New MyData
            loMyData.Value = (laListItems(i))
            laListItems2.Add(loMyData)
        Next
        Return laListItems2
End Function
 
Public Function ToCollection(ByVal lsString As String) As Collection
        Dim laListItems As Array = Split(lsString, vbNewLine)
        Dim laCollection As New Collection
        Dim loMyData As MyData
        Dim i As Integer
        For i = 0 To laListItems.Length - 1
            loMyData = New MyData
            loMyData.Value = (laListItems(i))
            laCollection.Add(loMyData)
        Next
        Return laCollection
End Function 

All you have to do then is to call the routines above and pass it to the sort subroutines (I turned the subroutines into functions for the purpose of this demo:

Private Sub btnSortArray_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSortArray.Click
        Dim laArrayList As New ArrayList
        Dim laArrayListSorted As New ArrayList
        laArrayList = ToArrayList(txtItemList.Text)
        laArrayListSorted = SortObjectCol(laArrayList, 0, laArrayList.Count - 1, "Value")
    End Sub
    Private Sub btnSortCollection_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSortCollection.Click
        Dim laCollection As New Collection
        Dim laCollectionSorted As New Collection
        laCollection = ToCollection(txtItemList.Text)
        laCollectionSorted = SortCollection(laCollection, "Value", True)
    End Sub 

Here is how the sorted objects will then look like:

ArrayList Sorted:
Sorting_Collection_and_ArrayList_2.jpg

Collection Sorted:
Sorting_Collection_and_ArrayList_3.jpg

Try out the project attached bellow and let me know if you got it. remember to put breakpoints at the end of the button click subs to see what's in the sorted objects.

Pete

[gusadolfo]

Hi digioz i found this code and it's very useful but also i'm looking for an example on how to page an arraylist, i have a function that loads an arraylist from a xml file and this arraylist fills 4 flowlayoutpanels (flp) in the main form that shows 4 lists with previews of the top items for each category (images, sounds, videos and games), each flp has a limit of max items. Now i have to show two pages of items but in the same form and i don't know how to do it, if you could help me out with this i would really appreciate it.

[digioz]

Hello Gusadolfo,

Can you post the code that you have so far? It will make it easier to understand what you are trying to do.

Thanks,
Pete

[gusadolfo]

here's the code, the arraylist i want to page is item, it belongs to the cItems class that is an object that has a cItem class that are the arraylist which contains the items on sale, i need to page it to show it in two different pages, i hope you understood what i'm trying to do here

Code:

Private Sub mostrar()
        Dim itemsDispo As ArrayList = objCarrito.TiposDeItem
        Dim cantImagen, cantSonido, cantJuegos, cantVideos As Integer
        Dim _itemsSonidoXPagina As Integer = 8
        Dim _itemsImagenXPagina As Integer = 7
        Dim vtn As frmHomeTop = New frmHomeTop()

        Dim _indice As Integer = 0
        Dim _itemsXPagina As Integer = 10
        Dim _totalarr As Integer = 0
        Dim ini As Integer = _indice * _itemsXPagina
        Dim fin As Integer = ini + (_itemsXPagina - 1)

        vtn.MouseVisible = MouseVisible
        vtn.ModeloTelefonoNombre = My.Settings.ModeloTelefonoNombre
        vtn.ModeloTelefonoImagen = My.Settings.ModeloTelefonoImagen
        vtn.Show()
        Me.ParentForm.Close()

        objCarrito.SeleccionarDestacadoDisponibles() <--RETURNS THE AVAILABLE ITEMS

        For Each item As FrontEnd.CarritoWEB.cItem In objCarrito.Items

            Select Case item.TipoItemId
                Case 1, 10
                    If cantImagen < _itemsImagenXPagina Then
                        Dim it As ucItemImagenHm = New ucItemImagenHm(item)
                        vtn.flpImagen.Controls.Add(it)
                        cantImagen += 1
                    End If
                Case 2, 5, 11
                    If cantSonido < _itemsSonidoXPagina Then
                        Dim it As ucItemSonidoHm = New ucItemSonidoHm(item)
                        vtn.flpSonido.Controls.Add(it)
                        cantSonido += 1
                    End If
                Case 3
                    If cantJuegos < _itemsImagenXPagina Then
                        Dim it As ucItemImagenHm = New ucItemImagenHm(item)
                        vtn.flpJuegos.Controls.Add(it)
                        cantJuegos += 1
                    End If
                Case 8
                    If cantVideos < _itemsImagenXPagina Then
                        Dim it As ucItemImagenHm = New ucItemImagenHm(item)
                        vtn.flpVideos.Controls.Add(it)
                        cantVideos += 1
                    End If
            End Select
        Next

    End Sub