?
Solved

Help Speed up function when sorting a listbox

Posted on 2014-03-07
5
Medium Priority
?
249 Views
Last Modified: 2014-03-10
excel 2010 vba.

Passing parameters to this function:

Call blnSort_List_Box(UserForm2.ListBox32, 3, True, True, FName)

Example: FName = "AMAZON SUPPLY"
If FName exists in the listbox that row gets bumped to the top of the list



Problem..
Filling a listbox then soting via these parameters.
sometimes the listbox contains 800 items.
THis code is talking 13-20 sec to sort.

Just looking to see if there is a way to make i run faster.



Public Function blnSort_List_Box(ByRef objListbox As Control, _
                                  ByVal lngSort_Column As Long, _
                                  ByVal blnSort_Alphanumeric As Boolean, _
                                  ByVal blnSort_Ascending As Boolean, _
                                  Optional ByVal vntPriority_Value As Variant) As Boolean

  Dim blnReturn                                         As Boolean
  Dim lngColumn                                         As Long
  Dim lngErr_Number                                     As Long
  Dim lngRow                                            As Long
  Dim lngRow1                                           As Long
  Dim strErr_Description                                As String
  Dim strPriority_Value                                 As String
  Dim vntList                                           As Variant
  Dim vntSwap                                           As Variant
    
  On Error GoTo Err_blnSort_List_Box
  
  blnReturn = False

  vntList = objListbox.List
  If Not IsMissing(vntPriority_Value) Then
     strPriority_Value = UCase$(vntPriority_Value)                                                                                                      ' *** NL [18/12/2013]: Changed from CStr(...) to UCase$(...)
     For lngRow = LBound(vntList, 1&) To (UBound(vntList, 1&) - 1&)
         If Not IsNull(vntList(lngRow, lngSort_Column)) Then
            If InStr(UCase$(vntList(lngRow, lngSort_Column)), strPriority_Value) > 0 Then                                                               ' *** NL [18/12/2013]: Added
               vntList(lngRow, lngSort_Column) = Chr$(1) & CStr(vntList(lngRow, lngSort_Column))
            End If                                                ' *** NL [18/12/2013]: Added
         End If
         
     Next lngRow
  End If
  
  If (blnSort_Alphanumeric) Then
     For lngRow = LBound(vntList, 1&) To (UBound(vntList, 1&) - 1&)
         For lngRow1 = (lngRow + 1&) To UBound(vntList, 1&)
             If (blnSort_Ascending) Then
                If IIf(Len(Trim$(IIf(IsNull(vntList(lngRow, lngSort_Column)), "", vntList(lngRow, lngSort_Column)))) = 0, String$(255, Chr$(255)), vntList(lngRow, lngSort_Column)) > _
                   IIf(Len(Trim$(IIf(IsNull(vntList(lngRow1, lngSort_Column)), "", vntList(lngRow1, lngSort_Column)))) = 0, String$(255, Chr$(255)), vntList(lngRow1, lngSort_Column)) Then
                   For lngColumn = 0& To (objListbox.ColumnCount - 1&)
                       vntSwap = vntList(lngRow, lngColumn)
                       vntList(lngRow, lngColumn) = vntList(lngRow1, lngColumn)
                       vntList(lngRow1, lngColumn) = vntSwap
                   Next lngColumn
                End If
             Else
                If vntList(lngRow, lngSort_Column) < vntList(lngRow1, lngSort_Column) Then
                   For lngColumn = 0& To (objListbox.ColumnCount - 1&)
                       vntSwap = vntList(lngRow, lngColumn)
                       vntList(lngRow, lngColumn) = vntList(lngRow1, lngColumn)
                       vntList(lngRow1, lngColumn) = vntSwap
                   Next lngColumn
                End If
             End If
    
         Next lngRow1
         
     Next lngRow
  Else
' Note: Substitute CInt() with another conversion type [CLng(), CDec(), etc.] depending on the column's numeric values.
'       Also, change the value 32767 (Integer) to the maximum value the revised data type can store.
     For lngRow = LBound(vntList, 1&) To (UBound(vntList, 1&) - 1&)
         For lngRow1 = (lngRow + 1&) To UBound(vntList, 1&)
             If (blnSort_Ascending) Then
                If CInt(IIf(Len(Trim$(IIf(IsNull(vntList(lngRow, lngSort_Column)), "", vntList(lngRow, lngSort_Column)))) = 0, 32767, vntList(lngRow, lngSort_Column))) > _
                   CInt(IIf(Len(Trim$(IIf(IsNull(vntList(lngRow1, lngSort_Column)), "", vntList(lngRow1, lngSort_Column)))) = 0, 32767, vntList(lngRow1, lngSort_Column))) Then
                   For lngColumn = 0& To (objListbox.ColumnCount - 1&)
                        vntSwap = IIf(Len(Trim$(IIf(IsNull(vntList(lngRow, lngColumn)), "", vntList(lngRow, lngColumn)))) = 0, "", vntList(lngRow, lngColumn))
                        vntList(lngRow, lngColumn) = IIf(Len(Trim$(IIf(IsNull(vntList(lngRow1, lngColumn)), "", vntList(lngRow1, lngColumn)))) = 0, "", vntList(lngRow1, lngColumn))
                        vntList(lngRow1, lngColumn) = vntSwap
                   Next lngColumn
                End If
             Else
                If CInt(IIf(Len(Trim$(IIf(IsNull(vntList(lngRow, lngSort_Column)), "", vntList(lngRow, lngSort_Column)))) = 0, "0", vntList(lngRow, lngSort_Column))) < _
                   CInt(IIf(Len(Trim$(IIf(IsNull(vntList(lngRow1, lngSort_Column)), "", vntList(lngRow1, lngSort_Column)))) = 0, "0", vntList(lngRow1, lngSort_Column))) Then
                   For lngColumn = 0& To (objListbox.ColumnCount - 1&)
                       vntSwap = IIf(Len(Trim$(IIf(IsNull(vntList(lngRow, lngColumn)), "", vntList(lngRow, lngColumn)))) = 0, "", vntList(lngRow, lngColumn))
                       vntList(lngRow, lngColumn) = IIf(Len(Trim$(IIf(IsNull(vntList(lngRow1, lngColumn)), "", vntList(lngRow1, lngColumn)))) = 0, "", vntList(lngRow1, lngColumn))
                       vntList(lngRow1, lngColumn) = vntSwap
                   Next lngColumn
                End If
             End If
    
         Next lngRow1
         
     Next lngRow
  End If
  
  If Not IsMissing(vntPriority_Value) Then
     For lngRow = LBound(vntList, 1&) To (UBound(vntList, 1&) - 1&)
         
         If Not (IsNull(vntList(lngRow, lngSort_Column))) Then
            If Len(Trim$(vntList(lngRow, lngSort_Column))) > 0 Then
               If Asc(vntList(lngRow, lngSort_Column)) = 1 Then
                  vntList(lngRow, lngSort_Column) = Mid$(vntList(lngRow, lngSort_Column), 2)
               End If
            End If
         End If
         
     Next lngRow
  End If
    
  objListbox.List = vntList
    
  blnReturn = True

Open in new window

0
Comment
Question by:fordraiders
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 23

Expert Comment

by:Ejgil Hedegaard
ID: 39914678
Save the array with the list to a worksheet, sort, and read the values back to the listbox.
It will take "no time" to sort 800 values on a worksheet.
The sheet can be hidden, but has to be activated to perform the sorting operation.
0
 
LVL 3

Author Comment

by:fordraiders
ID: 39915289
I have tried that in the past...I need to be able to do this in an array sort for function code please.
0
 
LVL 23

Expert Comment

by:Ejgil Hedegaard
ID: 39916179
I searched for a VBA sorting method some years back, but no matter what I found, it was slow (very slow) compared to put the array on a worksheet, sort and read the array again. So I always do that.
Sorry, can't help with a VBA solution.
0
 
LVL 81

Accepted Solution

by:
byundt earned 2000 total points
ID: 39916538
John Walkenbach discussed the results of a study he performed on sorting data in VBA in his book Excel 2002 Power Programming With VBA. I'd guess that other versions of that same book include the same discussion.

Walkenbach was able to consistently beat the speed of the worksheet sort using a so-called counting sort: 0.11 seconds for 1000 random elements using Excel worksheet sort and 0.00 seconds using a counting sort.

If you don't have the CD that accompanies Walkenbach's book (that's where the code is posted), then you may find a version of the counting sort for multi-dimensional arrays to be useful. There is a forum question discussing that issue in VBA Express "Counting sort for multi-dimensional arrays" http://www.vbaexpress.com/forum/showthread.php?3255-Solved-Counting-sort-for-multi-dimensional-arrays  That thread includes code for both sorting a single column as well as sorting by one column while retaining results in other columns of that array.
0
 
LVL 3

Author Closing Comment

by:fordraiders
ID: 39919711
Thanks very much
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question