revise code to not be case sensitive and add additional sort column in listbox

Hi again,

Please find attached an update to the workbook that addresses just the first of your two requirements; namely, "Not Case Sensitive on Column 0 value when sorting".

I thought I would offer the code in two stages to make the transition from the previous workbook easier.

I changed the blnSort_List_Box(...) routine by added an additional parameter, Optional ByVal blnCase_Sensitive As Boolean = True, & added the associated code to act upon this parameter value within the routine.

I also added a Check-box to the UserForm to select (check) if the sort was to be "Case Sensitive" (checked), or not (unchecked).

The revised code from the "frmQ_28264352" code module is as follows:

' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28264352.html ]
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               Q_28264352
' Question Title:   revise code to not be case sensitive and add additional sort column in listbox
' Question Asker:   fordraiders                                [ http://www.experts-exchange.com/M_531243.html ]
' Question Dated:   2013-10-11 at 08:49:43
'
' Expert Comment:   fanpages                                   [ http://www.experts-exchange.com/M_258171.html ]
' Copyright:        (c) 2013 Clearlogic Concepts (UK) Limited                           [ http://NigelLee.info ]
'
' See also:
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28249788.html ]
' --------------------------------------------------------------------------------------------------------------
Option Explicit
Private Sub SortListBox(oLb As MSForms.ListBox, sCol As Integer, sType As Integer, sDir As Integer)

' Included for backward compatibility with existing code using Run "SortListBox", ListBox1, {sCol}, {sType}, {sDir}

  On Error Resume Next
  
  Call blnSort_List_Box(oLb, CLng(sCol), (sType = 1), (sDir = 1), True)
  
End Sub
Private 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 blnCase_Sensitive As Boolean = False, _
                                  Optional ByVal vntPriority_Value As Variant) As Boolean

  Dim blnReturn                                         As Boolean
  Dim intValue1                                         As Integer
  Dim intValue2                                         As Integer
  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 strValue1                                         As String
  Dim strValue2                                         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 = CStr(vntPriority_Value)
     
     For lngRow = LBound(vntList, 1&) To (UBound(vntList, 1&) - 1&)
         
         If Not IsNull(vntList(lngRow, lngSort_Column)) Then
            strValue1 = CStr(vntList(lngRow, lngSort_Column))
            strValue2 = strPriority_Value
            
            If Not (blnCase_Sensitive) Then
               strValue1 = UCase$(strValue1)
               strValue2 = UCase$(strValue2)
            End If ' If Not (blnCase_Sensitive) Then
            
            If strValue1 = strValue2 Then
               vntList(lngRow, lngSort_Column) = Chr$(1) & CStr(vntList(lngRow, lngSort_Column))
            End If ' If strValue1 = strValue2 Then
         End If ' If Not IsNull(vntList(lngRow, lngSort_Column)) Then
         
     Next lngRow
  End If ' If Not IsMissing(vntPriority_Value) Then
  
  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
                strValue1 = IIf(Len(Trim$(IIf(IsNull(vntList(lngRow, lngSort_Column)), "", vntList(lngRow, lngSort_Column)))) = 0, String$(255, Chr$(255)), vntList(lngRow, lngSort_Column))
                strValue2 = IIf(Len(Trim$(IIf(IsNull(vntList(lngRow1, lngSort_Column)), "", vntList(lngRow1, lngSort_Column)))) = 0, String$(255, Chr$(255)), vntList(lngRow1, lngSort_Column))
                
                If Not (blnCase_Sensitive) Then
                   strValue1 = UCase$(strValue1)
                   strValue2 = UCase$(strValue2)
                End If ' If Not (blnCase_Sensitive) Then
                
                If strValue1 > strValue2 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 ' If strValue1 > strValue2 Then
             Else
                strValue1 = vntList(lngRow, lngSort_Column)
                strValue2 = vntList(lngRow1, lngSort_Column)
                
                If Not (blnCase_Sensitive) Then
                   strValue1 = UCase$(strValue1)
                   strValue2 = UCase$(strValue2)
                End If ' If Not (blnCase_Sensitive) Then
                
                If strValue1 < strValue2 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 ' If strValue1 < strValue2 Then
             End If ' If (blnSort_Ascending) Then
    
         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(vntList(lngRow, lngSort_Column)) > CInt(vntList(lngRow1, lngSort_Column)) Then
                intValue1 = CInt(IIf(Len(Trim$(IIf(IsNull(vntList(lngRow, lngSort_Column)), "", vntList(lngRow, lngSort_Column)))) = 0, 32767, vntList(lngRow, lngSort_Column)))
                intValue2 = CInt(IIf(Len(Trim$(IIf(IsNull(vntList(lngRow1, lngSort_Column)), "", vntList(lngRow1, lngSort_Column)))) = 0, 32767, vntList(lngRow1, lngSort_Column)))
                
                If intValue1 > intValue2 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 ' If intValue1 > intValue2 Then
             Else
                intValue1 = CInt(IIf(Len(Trim$(IIf(IsNull(vntList(lngRow, lngSort_Column)), "", vntList(lngRow, lngSort_Column)))) = 0, "0", vntList(lngRow, lngSort_Column)))
                intValue2 = CInt(IIf(Len(Trim$(IIf(IsNull(vntList(lngRow1, lngSort_Column)), "", vntList(lngRow1, lngSort_Column)))) = 0, "0", vntList(lngRow1, lngSort_Column)))
                
                If intValue1 < intValue2 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 ' If intValue1 < intValue2 Then
             End If ' If (blnSort_Ascending) Then
    
         Next lngRow1
         
     Next lngRow
  End If ' If (blnSort_Alphanumeric) Then
  
  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 ' If Asc(vntList(lngRow, lngSort_Column)) = 1 Then
            End If ' If Len(Trim$(vntList(lngRow, lngSort_Column))) > 0 Then
         End If ' If Not (IsNull(vntList(lngRow, lngSort_Column))) Then
         
     Next lngRow
  End If ' If Not IsMissing(vntPriority_Value) Then
    
  objListbox.List = vntList
    
  blnReturn = True
  
Exit_blnSort_List_Box:

  On Error Resume Next
  
  blnSort_List_Box = blnReturn
  
  Exit Function
  
Err_blnSort_List_Box:

  lngErr_Number = Err.Number
  strErr_Description = Err.Description
  
  On Error Resume Next
  
  MsgBox "Error #" & CStr(lngErr_Number) & _
         vbCrLf & vbLf & _
         strErr_Description, _
         vbExclamation Or vbOKOnly, _
         ThisWorkbook.Name
  Resume Next
  blnReturn = False
  
  Resume Exit_blnSort_List_Box
  
End Function
Private Sub cmdClose_Click()

  On Error Resume Next
  
' Unload Me
  Me.Hide
  
End Sub
Private Sub cmdRandomize_Click()

  Dim lngLoop                                           As Long
  Dim vntCode                                           As Variant
  Dim vntCountCode                                      As Variant
  Dim vntDescription                                    As Variant
  Dim vntMfgName                                        As Variant
  Dim vntMfgNumber                                      As Variant
  Dim vntStockCode                                      As Variant
  
  On Error Resume Next
  
  vntMfgName = Array("LOWES", "Lowes", _
                     "HOME DEPOT", "Home Depot", "HOME depot", "home DEPOT", _
                     "TRUE VALUE", "True Value", "TRUE value", "true VALUE", _
                     "BARNES", "Barnes", "barnes", _
                     "SAMS", "Sams", "sams", _
                     "AMAZON", "Amazon", "amazon", _
                     "AAAA", "aaaa", "AAaa", "AaAa", "aaAA", _
                     "ZZZZ", "zzzz", "ZZzz", "ZzZz", "zzZZ")
                     
  vntMfgNumber = Array("11221", "3809-B", "81813", "J47104", "63642502581", "11N257", "24A-50", "24A-62", "119613")
  
  vntDescription = Array("PAPER TOWEL", _
                         "TRASH CAN LINER", _
                         "Exit Sign,5x14In,GRN/WHT,Exit,SURF,PK10", _
                         "Socket Set 1/4dr 10 PC", _
                         "Flap Wheel,AO,1x1x1/4 In Shank,80G", _
                         "Flap Wheel,AO,2x1x1/4-20 Shank,60G", _
                         "Marking Chalk Refill,Perm,Red,2.5 lb", _
                         "Nozzle,1/2 In  Plasma,Tweco,Pk 2", _
                         "Nozzle,Adjustable 5/8 In,Tweco,Pk 2", _
                         "Nozzle,Flush,Bore 5/8 In,Screw on", _
                         "Nozzle,Orifice Flush,1/2,PK 2", _
                         "Paint Marker,Valve Action,Orange", _
                         "Penetrant,Cleaner")
                         
  vntCode = Array("EM", "FE", "DE", "RE", "TR")
  vntStockCode = Array("DISCD", "STOCK")
  vntCountCode = Array("CN", "US", "BC", "WW", "EN", "ZZ", "DD", "AA", "YS")
  
  Me.ListBox1.Clear
  
  For lngLoop = 1& To 100&
  
      Randomize
      
      If Int(Rnd() * 10) > 8 Then
         Me.ListBox1.AddItem vbNullString
         Me.ListBox1.List(Me.ListBox1.ListCount - 1&, 6&) = lngLoop
      Else
'        Me.ListBox1.AddItem Chr$(Int(Rnd() * 26) + 65)

         Me.ListBox1.AddItem vntMfgName(CLng(Int(Rnd() * CSng(UBound(vntMfgName)))))
         Me.ListBox1.List(Me.ListBox1.ListCount - 1&, 1&) = vntMfgNumber(CLng(Int(Rnd() * (1! + CSng(UBound(vntMfgNumber))))))
         Me.ListBox1.List(Me.ListBox1.ListCount - 1&, 2&) = vntDescription(CLng(Int(Rnd() * (1! + CSng(UBound(vntDescription))))))
         Me.ListBox1.List(Me.ListBox1.ListCount - 1&, 3&) = vntCode(CLng(Int(Rnd() * (1! + CSng(UBound(vntCode))))))
         Me.ListBox1.List(Me.ListBox1.ListCount - 1&, 4&) = vntStockCode(CLng(Int(Rnd() * (1! + CSng(UBound(vntStockCode))))))
         Me.ListBox1.List(Me.ListBox1.ListCount - 1&, 5&) = vntCountCode(CLng(Int(Rnd() * (1! + CSng(UBound(vntCountCode))))))
      
'        Me.ListBox1.List(Me.ListBox1.ListCount - 1&, 6&) = Int(Rnd() * 100) + 1
         Me.ListBox1.List(Me.ListBox1.ListCount - 1&, 6&) = lngLoop
      End If ' If Int(Rnd() * 10) > 8 Then
      
  Next lngLoop
  
  Set vntCode = Nothing
  Set vntCountCode = Nothing
  Set vntDescription = Nothing
  Set vntMfgName = Nothing
  Set vntMfgNumber = Nothing
  Set vntStockCode = Nothing
  
End Sub
Private Sub cmdSort_Click()

  On Error Resume Next
  
  Select Case (Me.ComboBox1.ListIndex)
  
      Case (0&)                                     ' Sort by the 1st column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 0, True, True, Me.chkCase_Sensitive.Value)
          
      Case (1&)                                     ' Sort by the 1st column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 0, True, False, Me.chkCase_Sensitive.Value)
          
      Case (2&)                                     ' Sort by the 2nd column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 1, True, True, Me.chkCase_Sensitive.Value)
          
      Case (3&)                                     ' Sort by the 2nd column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 1, True, False, Me.chkCase_Sensitive.Value)
          
      Case (4&)                                     ' Sort by the 3rd column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 2, True, True, Me.chkCase_Sensitive.Value)
          
      Case (5&)                                     ' Sort by the 3rd column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 2, True, False, Me.chkCase_Sensitive.Value)
          
      Case (6&)                                     ' Sort by the 4th column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 3, True, True, Me.chkCase_Sensitive.Value)
          
      Case (7&)                                     ' Sort by the 4th column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 3, True, False, Me.chkCase_Sensitive.Value)
          
      Case (8&)                                     ' Sort by the 5th column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 4, True, True, Me.chkCase_Sensitive.Value)
          
      Case (9&)                                     ' Sort by the 5th column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 4, True, False, Me.chkCase_Sensitive.Value)
          
      Case (10&)                                    ' Sort by the 6th column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 5, True, True, Me.chkCase_Sensitive.Value)
          
      Case (11&)                                    ' Sort by the 6th column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 5, True, False, Me.chkCase_Sensitive.Value)
          
      Case (12&)                                    ' Sort by the 7th column in the ListBox Numerically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 6, False, True, Me.chkCase_Sensitive.Value)
          
      Case (13&)                                    ' Sort by the 7th column in the ListBox Numerically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 6, False, False, Me.chkCase_Sensitive.Value)
          
      Case (14&)                                    ' Priority Sort by the 1st column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 0, True, True, Me.chkCase_Sensitive.Value, strSelected_MfgName)
          
      Case (15&)                                     ' Priority Sort by the 1st column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 0, True, False, Me.chkCase_Sensitive.Value, strSelected_MfgName)
          
      Case Else
      
  End Select ' Select Case (Me.ComboBox1.ListIndex)
  
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

  Dim lngLoop                                           As Long
  Dim strMsg                                            As String
  
  On Error Resume Next
  
  For lngLoop = 0& To (Me.ListBox1.ColumnCount - 1&)
      strMsg = strMsg & _
               IIf(lngLoop > 0&, vbCrLf & vbLf, "") & _
               "Column #" & CStr(lngLoop) & _
               vbCrLf & _
               Me.ListBox1.List(Me.ListBox1.ListIndex, lngLoop)
  Next lngLoop
  
  MsgBox strMsg, _
         vbInformation Or vbOKOnly, _
         ThisWorkbook.Name

End Sub
Private Sub UserForm_Activate()

  On Error Resume Next
  
  Me.Caption = "Q_28264352 - fanpages " & _
               IIf(Len(Trim$(strSelected_MfgName)) > 0, _
                   "(Selected: " & strSelected_MfgName & ")", _
                   "")
  
  Me.ComboBox1.Clear
  
  Me.ComboBox1.AddItem "Alphabetically 1st column in Ascending Order"
  Me.ComboBox1.AddItem "Alphabetically 1st column in Descending Order"

  Me.ComboBox1.AddItem "Alphabetically 2nd column in Ascending Order"
  Me.ComboBox1.AddItem "Alphabetically 2nd column in Descending Order"

  Me.ComboBox1.AddItem "Alphabetically 3rd column in Ascending Order"
  Me.ComboBox1.AddItem "Alphabetically 3rd column in Descending Order"

  Me.ComboBox1.AddItem "Alphabetically 4th column in Ascending Order"
  Me.ComboBox1.AddItem "Alphabetically 4th column in Descending Order"

  Me.ComboBox1.AddItem "Alphabetically 5th column in Ascending Order"
  Me.ComboBox1.AddItem "Alphabetically 5th column in Descending Order"

  Me.ComboBox1.AddItem "Alphabetically 6th column in Ascending Order"
  Me.ComboBox1.AddItem "Alphabetically 6th column in Descending Order"

  Me.ComboBox1.AddItem "Numerically 7th column in Ascending Order"
  Me.ComboBox1.AddItem "Numerically 7th column in Descending Order"
  
  If Len(Trim$(strSelected_MfgName)) > 0 Then
     Me.ComboBox1.AddItem "Alphabetically 1st column with [" & strSelected_MfgName & "] first, the rest in Ascending Order"
     Me.ComboBox1.AddItem "Alphabetically 1st column in Descending Order, with [" & strSelected_MfgName & "] last"
  End If ' If Len(Trim$(strSelected_MfgName)) > 0 Then
  
  Me.ComboBox1.ListIndex = 0&
  Me.chkCase_Sensitive.Value = False
  
End Sub
Private Sub UserForm_Initialize()
  
  On Error Resume Next
  
  Call cmdRandomize_Click
  
End Sub

Select allOpen in new window

The worksheet code module, "shtQ_28264352", & the (This)Workbook code module, "wbkQ_28264352", have both changed simply to reference the new UserForm name, "frmQ_28264352".

Please can you check that the modifications within the workbook address your first requirement?

Once this is confirmed, I will address your second requirement (the additional sorting, both on column 0 as is the case presently, & also on column 3).

Thank you.

BFN,

fp.
Q-28264352.xlsm

Thanks will check it out...Great stuff !

OK, noted.  Thanks for letting me know.

...

...by added an additional parameter...

Or even adding one :)

Have you found the opportunity to progress with your review within the last week, fordraiders?

no, sorry been on vacation...will look at it today...Thanks

fanpages, Yes, the first part is working fine..

fanpages, Sorry for the delay in getting back. Everything is fine on the mfgname first part.

"Once this is confirmed, I will address your second requirement (the additional sorting, both on column 0 as is the case presently, & also on column 3)"

Thanks again for the time to complete this.

fanpages, please let me know status in completing this question please.

also having a problem...if the mfgname contains an apostrophe in the name...it will not catch it..
for example:

LOWE'S  will not bubble to the top
but LOWES will..

also having a problem...if the mfgname contains an apostrophe in the name...it will not catch it..
for example:

LOWE'S  will not bubble to the top
but LOWES will..

Sorry I missed your recent responses, but since my recent (well, from April 2013) return to Experts-Exchange.com (after an extended break as I didn't like the site's redesign a few years ago) I have started ignoring responses to questions with more than a week since the last response.

This is purely because I would sooner be involved in active threads rather than those that may have been abandoned.  I saw your responses now as I was reviewing all my open threads for the past month.

...

This aside, if I change my code within the cmdRandomize_Click() event of the "frmQ_28249788" module so that LOWE'S is used...

From:
vntMfgName = Array("LOWES", "HOME DEPOT", "TRUE VALUE", "BARNES", "SAMS", "AMAZON", "AAAA", "ZZZZ")

To:
vntMfgName = Array("LOWE'S", "HOME DEPOT", "TRUE VALUE", "BARNES", "SAMS", "AMAZON", "AAAA", "ZZZZ")

...and then change cell [F13] from LOWES to LOWE'S then I can "bubble to the top" using the "Alphabetically 1st column with [LOWE'S] first, the rest in Ascending Order" entry in the Form's list-box:


Are you seeing something different?

I have attached my modified workbook (with just the two changes I described above) so you can try the same test.
Q-28264352-LOWE-S.xlsm

yes, the last suggestion is fine...thanks...

lookinf forward to the additional column sorting

Beautiful work...!!! Thanks very much !

:)

You are very welcome.

Good luck with the rest of your project.