• Home
 · 
• VB function enhancement
 · 
• A simple ListView Column Sorter (alphanumeric, numeric, date)

A simple ListView Column Sorter (alphanumeric, numeric, date)

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

Returns
True if executed without error False if executed with error

Rate A simple ListView Column Sorter (alphanumeric, numeric, date)

• 1
• 2
• 3
• 4
• 5

(15(15 Vote))

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