Category: VB function enhancement
Compatability: Visual Basic 3.0
Difficulty: Beginner
Date Added: Wed 3rd February 2021
Rating: (14 Votes)
A handy module used for sorting a ListView Column (in report view). The column can be sorted alphanumerically, numerically or by date (ascending and descending)
Inputs
ListViewControl As MSComctlLib.ListView
ColumnIndex as Integer
SortType As Integer
SortOrder As Integer
Assumes
The listview date is in the general date format
Will allow zero length strings in the sort for all types.
Will not allow non-numeric values for sortNumeric (except zero length strings)
Will not allow anything other than a date or zero length string for sortDate
Code Returns
True if executed without error
False if executed with error
Public Const sortAlphanumeric = 0
Public Const sortNumeric = 1
Public Const sortDate = 2
Public Const sortAscending = 3
Public Const sortDescending = 4
Function SortColumn(ByVal ListViewControl As MSComctlLib.ListView, ColumnIndex As Integer, SortType As Integer, SortOrder As Integer) As Boolean
Dim x As Integer, y As Integer
On Error GoTo ErrHandler
Select Case SortType
'*** Alphanumeric sort
Case sortAlphanumeric
DoSort ListViewControl, SortOrder, ColumnIndex - 1
'*** Numeric Sort
Case sortNumeric
Dim strMax As String, strNew As String
'Find the longest (whole) number string length in the column
If ColumnIndex > 1 Then
For x = 1 To ListViewControl.ListItems.Count
If Len(ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1)) <> 0 Then 'ignores 0 length strings
If Len(CStr(Int(ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1)))) > Len(strMax) Then
strMax = CStr(Int(ListViewControl.ListItems(x).SubItems(ColumnIndex - 1)))
End If
End If
Next
Else
For x = 1 To ListViewControl.ListItems.Count
If Len(ListViewControl.ListItems(x)) <> 0 Then
If Len(CStr(Int(ListViewControl.ListItems(x)))) > Len(strMax) Then
strMax = CStr(Int(ListViewControl.ListItems(x)))
End If
End If
Next
End If
'hide the control - speeds up the sort
ListViewControl.Visible = False
If ColumnIndex > 1 Then
For x = 1 To ListViewControl.ListItems.Count
If Len(ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1)) = 0 Then
ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1) = "0" 'make 0 length strings = to "0"
ElseIf Len(CStr(Int(ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1)))) < Len(strMax) Then
'prefix all numbers with 0's as required
strNew = ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1)
For y = 1 To Len(strMax) - Len(CStr(Int(ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1))))
strNew = "0" & strNew
Next
ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1) = strNew
End If
Next
Else
For x = 1 To ListViewControl.ListItems.Count
If Len(ListViewControl.ListItems(x).Text) = 0 Then
ListViewControl.ListItems(x).Text = "0" 'make 0 length strings = to "0"
ElseIf Len(CStr(Int(ListViewControl.ListItems(x)))) < Len(strMax) Then
'prefix all numbers with 0's as required
strNew = ListViewControl.ListItems(x).Text
For y = 1 To Len(strMax) - Len(CStr(Int(ListViewControl.ListItems(x))))
strNew = "0" & strNew
Next
ListViewControl.ListItems(x).Text = strNew
End If
Next
End If
DoSort ListViewControl, SortOrder, ColumnIndex - 1
If ColumnIndex > 1 Then
'Remove preceding 0's
For x = 1 To ListViewControl.ListItems.Count
ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1) = CDbl(ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1))
If ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1) = 0 Then ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1) = ""
Next
Else
'Remove preceding 0's
For x = 1 To ListViewControl.ListItems.Count
ListViewControl.ListItems(x).Text = CDbl(ListViewControl.ListItems(x).Text)
If ListViewControl.ListItems(x).Text = 0 Then ListViewControl.ListItems(x).Text = ""
Next
End If
ListViewControl.Visible = True
'*** Date Sort
Case sortDate
ListViewControl.Visible = False
If ColumnIndex > 1 Then
'Convert dates to format that can be sorted alphanumerically
For x = 1 To ListViewControl.ListItems.Count
ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1) = Format(ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1), "YYYY MM DD hh:mm:ss")
Next
DoSort ListViewControl, SortOrder, ColumnIndex - 1
'Convert dates back to General Date format
For x = 1 To ListViewControl.ListItems.Count
ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1) = Format(ListViewControl.ListItems(x).ListSubItems(ColumnIndex - 1), "General Date")
Next
Else
'Convert dates to format that can be sorted alphanumerically
For x = 1 To ListViewControl.ListItems.Count
ListViewControl.ListItems(x).Text = Format(ListViewControl.ListItems(x).Text, "YYYY MM DD hh:mm:ss")
Next
DoSort ListViewControl, SortOrder, ColumnIndex - 1
'Convert dates back to General Date format
For x = 1 To ListViewControl.ListItems.Count
ListViewControl.ListItems(x).Text = Format(ListViewControl.ListItems(x).Text, "General Date")
Next
End If
ListViewControl.Visible = True
End Select
SortColumn = True
Exit_Function:
Exit Function
ErrHandler:
MsgBox Err.Description & " (" & Err.Number & ")", vbOKOnly + vbCritical, "ListView Sort module Error"
SortColumn = False
Resume Exit_Function
End Function
Private Sub DoSort(ByVal ListViewControl As MSComctlLib.ListView, SortOrder As Integer, SortKey As Integer)
If SortOrder = sortAscending Then
ListViewControl.SortOrder = lvwAscending
ElseIf SortOrder = sortDescending Then
ListViewControl.SortOrder = lvwDescending
End If
ListViewControl.SortKey = SortKey
ListViewControl.Sorted = True
End Sub
'******************************************************************
'************** EXAMPLE CALL FROM FORM - ON LISTVIEW COLUMN CLICK
'******************************************************************
'Private Sub lv_ColumnClick(Index As Integer, ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'
' Select Case ColumnHeader.Index
' Case 1
' If lv(Index).ColumnHeaders(ColumnHeader.Index).Icon = "up" Then
' SortColumn lv(Index), ColumnHeader.Index, sortAlphanumeric, sortDescending
' lv(Index).ColumnHeaders(ColumnHeader.Index).Icon = "down"
' Else
' SortColumn lv(Index), ColumnHeader.Index, sortAlphanumeric, sortAscending
' lv(Index).ColumnHeaders(ColumnHeader.Index).Icon = "up"
' End If
'
' Case 2
' If lv(Index).ColumnHeaders(ColumnHeader.Index).Icon = "up" Then
' SortColumn lv(Index), ColumnHeader.Index, sortNumeric, sortDescending
' lv(Index).ColumnHeaders(ColumnHeader.Index).Icon = "down"
' Else
' SortColumn lv(Index), ColumnHeader.Index, sortNumeric, sortAscending
' lv(Index).ColumnHeaders(ColumnHeader.Index).Icon = "up"
' End If
'
' Case 3
' If lv(Index).ColumnHeaders(ColumnHeader.Index).Icon = "up" Then
' SortColumn lv(Index), ColumnHeader.Index, sortDate, sortDescending
' lv(Index).ColumnHeaders(ColumnHeader.Index).Icon = "down"
' Else
' SortColumn lv(Index), ColumnHeader.Index, sortDate, sortAscending
' lv(Index).ColumnHeaders(ColumnHeader.Index).Icon = "up"
' End If
'
'
' End Select
'
' For x = 1 To lv(Index).ColumnHeaders.Count
' If x <> ColumnHeader.Index Then
' lv(Index).ColumnHeaders(x).Icon = "dot"
' End If
' Next
'End Sub