• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 357
  • Last Modified:

Sorting userform listbox but need Instr on next enhancement

previous solution from fanpages:

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28249788.html

Taking a value from a sheet.


If a names exists in a column 3 of a listbox..it will bubble those results...to the top.

What I need:
What I need:

I need to see if the code can look at the current spreadhsheet and find the current activecell...
Look one cell to the left -1.
Take that value  and see if it exists in Column  3 of the listbox.
(This value may appear in more than one row  in the listbox...)

If results are found those rows get bumped to the top of the list.
and then the rest of the rows are still sorted the same way as requested. beneath the rows that get bumped to to the top.

The code is working fine. But sometimes the Name i'm looking for may be embededd inside the column value.

So this time if i'm looking for "Barnes"

In column 3 it may say  "BARNES INC."

so if "BARNES" is within the column value..it will still bubble it to the top.

Thanks
fordraiders
0
Fordraiders
Asked:
Fordraiders
  • 7
  • 7
1 Solution
 
[ fanpages ]IT Services ConsultantCommented:
Hi again,

I have revised the previous code (from "Q_28249788") to check the presence of the search item (strPriority_Value) using the Instr(...) function as you requested.

This change was made within the blnSort_List_Box(...) function of the frmQ_28318945 User Form:

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 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 = CStr(vntPriority_Value)
     
     For lngRow = LBound(vntList, 1&) To (UBound(vntList, 1&) - 1&)
         
         If Not IsNull(vntList(lngRow, lngSort_Column)) Then
'           If CStr(vntList(lngRow, lngSort_Column)) = strPriority_Value Then                                                                           ' *** NL [16/12/2013]: Removed
            If InStr(CStr(vntList(lngRow, lngSort_Column)), strPriority_Value) > 0 Then                                                                 ' *** NL [16/12/2013]: Added
               vntList(lngRow, lngSort_Column) = Chr$(1) & CStr(vntList(lngRow, lngSort_Column))
            End If ' If Instr(CStr(vntList(lngRow, lngSort_Column)), strPriority_Value) > 0 Then                                                        ' *** NL [16/12/2013]: Added
'           End If ' If CStr(vntList(lngRow, lngSort_Column)) = strPriority_Value Then                                                                  ' *** NL [16/12/2013]: Removed
         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
'               If vntList(lngRow, lngSort_Column) > vntList(lngRow1, lngSort_Column) 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 ' If IIf(...) > IIf(...) Then
             Else
                If vntList(lngRow, lngSort_Column) < vntList(lngRow1, lngSort_Column) 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 ' If vntList(lngRow, lngSort_Column) < vntList(lngRow1, lngSort_Column) 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
                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 = vntList(lngRow, lngColumn)
'                       vntList(lngRow, lngColumn) = vntList(lngRow1, lngColumn)
                        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 CInt(...) > CInt(...) Then
             Else
'               If CInt(vntList(lngRow, lngSort_Column)) < CInt(vntList(lngRow1, lngSort_Column)) Then
                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 = vntList(lngRow, lngColumn)
'                      vntList(lngRow, lntColumn) = vntList(lngRow1, lngColumn)
                       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 CInt(...) < CInt(...) 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

Open in new window



I have attached a revised workbook.

BFN,

fp.
Q-28318945.xlsm
0
 
FordraidersAuthor Commented:
Thanks so much...will test it later today !
0
 
FordraidersAuthor Commented:
fanpages, Losing about 4 secs on speed.  but it is working..
0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
[ fanpages ]IT Services ConsultantCommented:
Yes, depending on the length of the strings being searched, & the quantity of strings to be searched, use of Instr(...) will slow the process down.  If the string to be found was always going to be a prefix, rather than being anywhere within the test string(s), then we could make improvements on execution time.

Alternatively, we could look at using Regular Expressions (implemented via the "VBScript.RegExp" object) rather than Instr(...), but this, again, may not make any worthwhile improvements in speed due to the length & quantity of strings to be searched.
0
 
FordraidersAuthor Commented:
I've requested that this question be closed as follows:

Accepted answer: 0 points for fordraiders's comment #a39722571

for the following reason:

appreciate all the help on this issue from the beginning.
0
 
[ fanpages ]IT Services ConsultantCommented:
[Object] button used.

I believe that my own comment ("ID: 39721094") should be the accepted comment.
0
 
FordraidersAuthor Commented:
Thanks for the help
0
 
[ fanpages ]IT Services ConsultantCommented:
You're very welcome :)
0
 
FordraidersAuthor Commented:
fanpages, One small issue..

If on the Sheet i have  "Barnes" or  "barnes"  instead of "BARNES"

its bubbling up correctly

Sorry.
fordraiders
0
 
[ fanpages ]IT Services ConsultantCommented:
Err... If it is "bubbling up" correctly, does that mean you have a problem, or you don't?
0
 
FordraidersAuthor Commented:
sorry,  its NOT bubbling up correctly.
0
 
[ fanpages ]IT Services ConsultantCommented:
Ah, OK :)

Please try this revision as attached.
Q-28318945b.xlsm
0
 
FordraidersAuthor Commented:
you are elite..very good...Thanks for all the extra help...Happy Holidays !
0
 
[ fanpages ]IT Services ConsultantCommented:
Best wishes to you, too :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 7
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now