Advertisement
5_2007-2008 VB function enhancement #184366

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)

AI

AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Source Code
original-source
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
Original Comments (3)
Recovered from Wayback Machine