Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Sorting userform listbox but need Instr on next enhancement

Posted on 2013-12-16
14
Medium Priority
?
350 Views
Last Modified: 2013-12-18
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
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
  • 7
  • 7
14 Comments
 
LVL 35

Accepted Solution

by:
[ fanpages ] earned 2000 total points
ID: 39721094
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
 
LVL 3

Author Comment

by:fordraiders
ID: 39722571
Thanks so much...will test it later today !
0
 
LVL 3

Author Comment

by:fordraiders
ID: 39722599
fanpages, Losing about 4 secs on speed.  but it is working..
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39722628
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
 
LVL 3

Author Comment

by:fordraiders
ID: 39722824
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
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39722825
[Object] button used.

I believe that my own comment ("ID: 39721094") should be the accepted comment.
0
 
LVL 3

Author Closing Comment

by:fordraiders
ID: 39723273
Thanks for the help
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39723297
You're very welcome :)
0
 
LVL 3

Author Comment

by:fordraiders
ID: 39725869
fanpages, One small issue..

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

its bubbling up correctly

Sorry.
fordraiders
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39726070
Err... If it is "bubbling up" correctly, does that mean you have a problem, or you don't?
0
 
LVL 3

Author Comment

by:fordraiders
ID: 39726462
sorry,  its NOT bubbling up correctly.
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39726520
Ah, OK :)

Please try this revision as attached.
Q-28318945b.xlsm
0
 
LVL 3

Author Comment

by:fordraiders
ID: 39726670
you are elite..very good...Thanks for all the extra help...Happy Holidays !
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39728364
Best wishes to you, too :)
0

Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
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 …
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

705 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