Solved

Sorting userform listbox but need Instr on next enhancement

Posted on 2013-12-16
14
308 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
  • 7
  • 7
14 Comments
 
LVL 35

Accepted Solution

by:
[ fanpages ] earned 500 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
 
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
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

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

707 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now