sorting listbox with additional information from current sheet

Excel vba:

The code below is some standard internet code to sorting a listbox asc or desc..numeric or alphabetically.

This code is executed by:
Run "SortListBox", ListBox1, 6, 1, 1

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.
 

Thanks
fordraiders

Sub SortListBox(oLb As MSForms.ListBox, sCol As Integer, sType As Integer, sDir As Integer)

    Dim vaItems As Variant
    Dim i As Long, j As Long
    Dim c As Integer
    Dim vTemp As Variant
    
    'Put the items in a variant array
  ' On Error GoTo SortListBox_Error
On Error Resume Next
    vaItems = oLb.List
    
    'Sort the Array Alphabetically(1)
    If sType = 1 Then
        For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
            For j = i + 1 To UBound(vaItems, 1)
                'Sort Ascending (1)
                If sDir = 1 Then
'                   If vaItems(i, sCol) > vaItems(j, sCol) Then
                    If IIf(Len(Trim$(IIf(IsNull(vaItems(i, sCol)), "", vaItems(i, sCol)))) = 0, String$(255, Chr$(255)), vaItems(i, sCol)) > _
                       IIf(Len(Trim$(IIf(IsNull(vaItems(j, sCol)), "", vaItems(j, sCol)))) = 0, String$(255, Chr$(255)), vaItems(j, sCol)) Then
                        For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If

                'Sort Descending (2)
                ElseIf sDir = 2 Then
                    If vaItems(i, sCol) < vaItems(j, sCol) Then
                        For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                End If
    
            Next j
        Next i
    'Sort the Array Numerically(2)
    '(Substitute CInt with another conversion type (CLng, CDec, etc.) depending on type of numbers in the column)
    ElseIf sType = 2 Then
        For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
            For j = i + 1 To UBound(vaItems, 1)
                'Sort Ascending (1)
                If sDir = 1 Then
'                   If CInt(vaItems(i, sCol)) > CInt(vaItems(j, sCol)) Then
                    If CInt(IIf(Len(Trim$(IIf(IsNull(vaItems(i, sCol)), "", vaItems(i, sCol)))) = 0, 32767, vaItems(i, sCol))) > _
                       CInt(IIf(Len(Trim$(IIf(IsNull(vaItems(j, sCol)), "", vaItems(j, sCol)))) = 0, 32767, vaItems(j, sCol))) Then
                        For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
'                           vTemp = vaItems(i, c)
'                           vaItems(i, c) = vaItems(j, c)
                            vTemp = IIf(Len(Trim$(IIf(IsNull(vaItems(i, c)), "", vaItems(i, c)))) = 0, "", vaItems(i, c))
                            vaItems(i, c) = IIf(Len(Trim$(IIf(IsNull(vaItems(j, c)), "", vaItems(j, c)))) = 0, "", vaItems(j, c))
                            vaItems(j, c) = vTemp
                        Next c
                    End If

                'Sort Descending (2)
                ElseIf sDir = 2 Then
'                   If CInt(vaItems(i, sCol)) < CInt(vaItems(j, sCol)) Then
                    If CInt(IIf(Len(Trim$(IIf(IsNull(vaItems(i, sCol)), "", vaItems(i, sCol)))) = 0, "0", vaItems(i, sCol))) < _
                       CInt(IIf(Len(Trim$(IIf(IsNull(vaItems(j, sCol)), "", vaItems(j, sCol)))) = 0, "0", vaItems(j, sCol))) Then
                        For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
'                           vTemp = vaItems(i, c)
'                           vaItems(i, c) = vaItems(j, c)
                            vTemp = IIf(Len(Trim$(IIf(IsNull(vaItems(i, c)), "", vaItems(i, c)))) = 0, "", vaItems(i, c))
                            vaItems(i, c) = IIf(Len(Trim$(IIf(IsNull(vaItems(j, c)), "", vaItems(j, c)))) = 0, "", vaItems(j, c))
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                End If
    
            Next j
        Next i
    End If
    
    'Set the list to the array
    oLb.List = vaItems
    
  Exit Sub
  
SortListBox_Error:'
  
End Sub

Open in new window

LVL 3
FordraidersAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

[ fanpages ]IT Services ConsultantCommented:
(cough)

The code below is some standard internet code to sorting a listbox asc or desc..numeric or alphabetically.

With some "non-standard" code I added because of your previous question:

"Sorting a listbox via code Update...not working with columns with null/blanks"
[ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28235471.html#a39481974 ]

This aside...

Do you have a sample workbook that you can upload/attach to this thread that contains test data, or do you need me to re-post the sample workbook I provided in the previous question?

[EDIT: 26/09/2013 09:20 (UK time) to add previous sample workbook ~ fp.]
Q-28235471.xlsm
0
FordraidersAuthor Commented:
if you could repost the sample workbook. That would be great. and sorry for the non-recognition of your work. did not mean to offend.
0
FordraidersAuthor Commented:
0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

[ fanpages ]IT Services ConsultantCommented:
Yes, that's right.

I have updated my previous comment to include the sample workbook from that thread in case anybody else wishes to look at the previous question for background.

Having reminded myself of that question though, it may be as easy to start again with test data to address this question.
0
FordraidersAuthor Commented:
fanpages, here is the file
Q-28235471-REVISED-0926.xlsm
0
FordraidersAuthor Commented:
fanpages, is this data sufficient?
0
[ fanpages ]IT Services ConsultantCommented:
Hi again,

I may be getting confused, or misunderstanding the purpose of your workbook.

The Listbox within your attached file only has two columns, and the statement you posted above (Run "SortListBox", ListBox1, 6, 1, 1) seems to indicate you have (at least) six columns.

The worksheet [Sheet1] you provided seems to include the transposed data from five columns (in the range [C33:G38]).  Again, not six.

I also do not understand your opening statement; "always the current cell will be the value in red but in different cells on the spreadsheet and a different column".

Do you mean the ActiveCell (the currently selected cell), or do you manually mark a cell in red to make it the "current cell"?


Either I am missing something like the Listbox &/or the data you are using, or there is something missing from your question.

This statement also puzzles me:
"AND THEN SORT THE LISTBOX IN COLUMN 3 BASED ON THIS VALUE..ANY VALUE BELOW  THEN GETS SORTED BY COLUMN 3 ASC OR DESC DEPENDS ON HOW SPECIFIED
IF THE VALUE DOES NOT EXIST…THEN NO SORT."

Do you mean you simply select a cell ([D19] = 11221), take the associated value one cell to the left ("BARNES", in the example within the worksheet), then re-order the Listbox so all the rows with "BARNES" in column 3 are displayed at the top, & then the rest of the rows (not "BARNES") are sorted alphabetically (ascending) on column 3?

Should there be any other sort criteria?  For example, in the range [C33:G38] you also seem to be sorting on the first column [C], although your closing statement seems to indicate it is column [G] (the fifth column):

"IF AT ALL POSSIBLE SORTING NEEDS TO OCCUE ON 2 COLUMNS  3  AND 5 ASC…"


Please can you confirm what is in the Listbox you are using, the total number of columns, & what you mean by "current cell" (in that, is it the current selection on the worksheet)?

Also, how is the data arranged in the worksheet where the selection occurs?

Is there any chance you can provide an example workbook that contains the data layout as you are using it; the actual workbook (not a workbook with question text) that includes some "test" data?  This need not be actual data, but simply to demonstrate a sample so I can copy the same format to expand for extended testing?

Thanks.

BFN,

fp.
0
FordraidersAuthor Commented:
fanpages,
 sorry for the confusion...

"Do you mean you simply select a cell ([D19] = 11221), take the associated value one cell to the left ("BARNES", in the example within the worksheet), then re-order the Listbox so all the rows with "BARNES" in column 3 are displayed at the top, & then the rest of the rows (not "BARNES") are sorted alphabetically (ascending) on column 3?"

Yes. this is exactly what i'am trying to do.

"Do you mean the ActiveCell (the currently selected cell), or do you manually mark a cell in red to make it the "current cell"?

Just the ActiveCell (the currently selected cell), . nothing manually marked in red.

===================================================
and forget this statement .  it is not necessary.

"Should there be any other sort criteria?  For example, in the range [C33:G38] you also seem to be sorting on the first column [C], although your closing statement seems to indicate it is column [G] (the fifth column):
"IF AT ALL POSSIBLE SORTING NEEDS TO OCCUE ON 2 COLUMNS  3  AND 5 ASC…"
===================================================


Hope this revision makes sense.
Q-28235471-REVISED2-0930.xlsm
0
[ fanpages ]IT Services ConsultantCommented:
Thanks.  Yes, that is much clearer.

Two final queries (sorry):

1) I presume you can select any cell on the rows where data resides.  The code should simply look in column [F] for the "Mfgname" to use for the preferred sort criteria.

2) Do you wish the list to be re-sorted within the existing worksheet?  Or do you still wish to use the list-box approach?  I wasn't clear whether you left my example list-box in the worksheet just because you didn't know how to remove it, or whether you did actually want the sorted data to be shown in a similar way?

Thanks again.
0
FordraidersAuthor Commented:
1) I presume you can select any cell on the rows where data resides.  The code should simply look in column [F] for the "Mfgname" to use for the preferred sort criteria

No , on my next project "Mfgname" could be inj Column [AA], or Column [H].
Whiach is why the stress on the Activcell...nine times out of ten...the cell immediatelt ot the left will be the mfgname column.


2) Do you wish the list to be re-sorted within the existing worksheet?  Or do you still wish to use the list-box approach?  I wasn't clear whether you left my example list-box in the worksheet just because you didn't know how to remove it, or whether you did actually want the sorted data to be shown in a similar way?

Do you wish the list to be re-sorted within the existing worksheet?  Or do you still wish to use the list-box approach?

2)a. Sorry but list-box approach only...

Nothong is to be written to the sheet , sorted and then presented to the listbox.

The "listbox data" comes straight from the recordset and getrows method.

Thanks
very very much !!
0
[ fanpages ]IT Services ConsultantCommented:
:)

OK.  I'll just go with the ActiveCell/Offset one column to the left approach.

However, I am now confused again!

I seem to be missing a link between the worksheet & the listbox being displayed.

The "listbox data" comes straight from the recordset and getrows method.

How is the data in the listbox/userform shown?  Do you click a button, is it when a cell is selected, or by some other manual (or automatic) process?

Are you using the UserForm (I provided, & that which is currently shown when the workbook opens) to show the listbox?

As you know, presently there are only two columns in the listbox I previous provided.  Do you now need me to create at least six columns of random data (but ensuring that there are some examples of the "Mfgname" you have provided to prove the revised code is working as expected?

...or...

Is the worksheet data you have provided going to be the test data in the listbox?


Obviously the UserForm width will need to be increased to accommodate these additional columns.  If you have an existing UserForm that you are displaying your data within shall I take a copy from you so I can apply the code directly to that?


Sorry if this is obvious, but you, of course, have your idea of the finished product &/or something resembling that already... & I think I only have part of the data & nothing representing the final presentation.

It is difficult to appreciate how all this fits together & if I can anticipate any issues that may arise & code "defensively" for these.

I am concerned that you are seeing one finished product, & I am assuming another, & that you may be disappointed with the outcome.

Thanks for any further information you can provide to describe the ultimate goal.
0
FordraidersAuthor Commented:
yes, and i apologize, I'm loading the listbox via against a recordset from access and using the   .getrows  method to load the listbox

The data in the spreadsheet is an example of what can be loaded into the listbox.

That would be great to just randomly load data into your new 6 column listbox and have it sorted as requested by the mfgname (ActiveCell/Offset one column to the left approach)

Then sorted by the mfgname after

"Do you now need me to create at least six columns of random data (but ensuring that there are some examples of the "Mfgname" you have provided to prove the revised code is working as expected?

yes.  That would be great.

Thanks again
fordraiders






I was displaying it on the sheet to give an example of what the data looks  like in the listbox.


 Arr = rst.GetRows
       rst.MoveFirst
i = 0



With frmResultAll.ListBox1
   .Clear
        .ColumnHeads = False
        .ColumnCount = rst.Fields.Count
.Column = Arr
        .ListIndex = -1
End With
example-listbox-and-sheet-mfgnam.bmp
0
[ fanpages ]IT Services ConsultantCommented:
:)

Thank you.  I'm almost there with the code.

I just have one final question:

If sorting in an ascending order, the selected "Mfgname" (e.g. "BARNES") will be at the top of the list(box) & all others will follow in ascending alphabetical order.

However, if sorting in a descending order, which condition should occur?

a) "BARNES" at the top of the list(box) & all others follow in a descending order,
or
a) All others (except "BARNES") listed in a descending order, & then all the "BARNES" entries at the very end?


Thanks for your patience so far :)

PS. I also noticed that throughout I have been referring to six columns & your opening question text states:

Run "SortListBox", ListBox1, 6, 1, 1

The 6 here indicates seven columns (0 relative; 0, 1, 2, 3, 4, 5, & 6).

What I've done is added a seventh column that includes a number; the original sequential order of the rows in the listbox.  I have also added a sort option (in the drop-down combobox) that allows the sorting of this seventh column in an ascending or descending order, so you can always return to the original order of all the items in the list if you wish to.
0
FordraidersAuthor Commented:
fanpages, Thanks for hanging with this.

If my folks want to get rid of the intial sort after displaying a name bubbled to the top.

Its totally up to them.

I'am not worried about anything after the results are brought back.

If they want to kill that presorted mfgname bubbled to the top...its up to them.
dont worry about that part.
But Thanks.


Great, Thanks for adding the extra column...

and i guess you have allowed for a null or blank cell if its exists to the left of the active cell. Because a Mfgname will not always be there. ?




fordraiders
0
[ fanpages ]IT Services ConsultantCommented:
Hi again,

As promised here is the workbook (attached).

Worksheet [Q_28249788] contains this Visual Basic for Applications code:

' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28249788.html ]
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               Q_28249788
' Question Title:   sorting listbox with additional information from current sheet
' Question Asker:   fordraiders                                [ http://www.experts-exchange.com/M_531243.html ]
' Question Dated:   2013-09-25 at 21:34:25
'
' Expert Comment:   fanpages                                   [ http://www.experts-exchange.com/M_258171.html ]
' Copyright:        (c) 2013 Clearlogic Concepts (UK) Limited                           [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------------------------
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  On Error GoTo Err_Worksheet_SelectionChange
  
  Application.EnableEvents = False
  
  If Not (Intersect(Target.Cells(1&), Range([G2], Cells(Cells.Rows.Count, "G").End(xlUp))) Is Nothing) Then
     strSelected_MfgName = Target.Cells(1&).Offset(, -1).Value
     
     If Len(Trim$(strSelected_MfgName)) > 0 Then
        frmQ_28249788.Show
     End If ' If Len(Trim$(strSelected_MfgName)) > 0 Then
  End If ' If Not (Intersect(Target, Range([G2], Cells(Cells.Rows.Count, "G").End(xlUp))) Is Nothing) Then
     
Exit_Worksheet_SelectionChange:

  On Error Resume Next

  Application.EnableEvents = True
  
  Exit Sub
  
Err_Worksheet_SelectionChange:

  On Error Resume Next
  
  Resume Exit_Worksheet_SelectionChange
  
End Sub

Open in new window



UserForm [frmQ_28249788] contains this code:

' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28249788.html ]
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               Q_28249788
' Question Title:   sorting listbox with additional information from current sheet
' Question Asker:   fordraiders                                [ http://www.experts-exchange.com/M_531243.html ]
' Question Dated:   2013-09-25 at 21:34:25
'
' Expert Comment:   fanpages                                   [ http://www.experts-exchange.com/M_258171.html ]
' Copyright:        (c) 2013 Clearlogic Concepts (UK) Limited                           [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------------------------
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))
  
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 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
               vntList(lngRow, lngSort_Column) = Chr$(1) & CStr(vntList(lngRow, lngSort_Column))
            End If ' If CStr(vntList(lngRow, lngSort_Column)) = strPriority_Value 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
'               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
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", "HOME DEPOT", "TRUE VALUE", "BARNES", "SAMS", "AMAZON", "AAAA", "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)
          
      Case (1&)                                     ' Sort by the 1st column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 0, True, False)
          
      Case (2&)                                     ' Sort by the 2nd column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 1, True, True)
          
      Case (3&)                                     ' Sort by the 2nd column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 1, True, False)
          
      Case (4&)                                     ' Sort by the 3rd column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 2, True, True)
          
      Case (5&)                                     ' Sort by the 3rd column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 2, True, False)
          
      Case (6&)                                     ' Sort by the 4th column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 3, True, True)
          
      Case (7&)                                     ' Sort by the 4th column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 3, True, False)
          
      Case (8&)                                     ' Sort by the 5th column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 4, True, True)
          
      Case (9&)                                     ' Sort by the 5th column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 4, True, False)
          
      Case (10&)                                    ' Sort by the 6th column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 5, True, True)
          
      Case (11&)                                    ' Sort by the 6th column in the ListBox Alphabetically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 5, True, False)
          
      Case (12&)                                    ' Sort by the 7th column in the ListBox Numerically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 6, False, True)
          
      Case (13&)                                    ' Sort by the 7th column in the ListBox Numerically in Descending Order
          Call blnSort_List_Box(Me.ListBox1, 6, False, False)
          
      Case (14&)                                    ' Priority Sort by the 1st column in the ListBox Alphabetically in Ascending Order
          Call blnSort_List_Box(Me.ListBox1, 0, True, True, 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, 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_28249788 - 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&
  
End Sub
Private Sub UserForm_Initialize()
  
  On Error Resume Next
  
  Call cmdRandomize_Click
  
End Sub

Open in new window



A new Public code module, [basQ_28249788], contains this code:

Option Explicit
' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28249788.html ]
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               Q_28249788
' Question Title:   sorting listbox with additional information from current sheet
' Question Asker:   fordraiders                                [ http://www.experts-exchange.com/M_531243.html ]
' Question Dated:   2013-09-25 at 21:34:25
'
' Expert Comment:   fanpages                                   [ http://www.experts-exchange.com/M_258171.html ]
' Copyright:        (c) 2013 Clearlogic Concepts (UK) Limited                           [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------------------------

Public strSelected_MfgName                              As String

Open in new window



When you click any value in column [G], as agreed, the UserForm will be shown with random data.  The [Sort] button will then need to be used after the appropriate entry in the drop-down Combobox is selected.

Note the new options in the drop-down Combobox; especially the last two in the list.

Please let me know if this meets your requirements.

Thank you.

BFN,

fp.
Q-28249788.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FordraidersAuthor Commented:
fanpages, Thanks.
maybe i'm not doing something correctly.
The from is not modeless. So i cant navigate on the sheet...So i added vbmodeless.


If i'am in Column G and the mfgname to the left of the active cell is "Barnes"
After selecting a sort order and clicking the "Sort" Button...the Barnes mfgnames...rows do not filter to the top...
Sorry.

or maybe i'm doing something wrong ?
0
[ fanpages ]IT Services ConsultantCommented:
maybe i'm not doing something correctly.
The from is not modeless. So i cant navigate on the sheet...So i added vbmodeless.

Sorry, you never asked for it to be modeless.

Please click [Close] to select another row from the worksheet.

If i'am in Column G and the mfgname to the left of the active cell is "Barnes"
After selecting a sort order and clicking the "Sort" Button...the Barnes mfgnames...rows do not filter to the top...

I suspect this is linked to not closing the form & your own change.

Please remove the vbModeless option, & use by closing the UserForm between selections, & I think you'll find it does function as expected.
0
FordraidersAuthor Commented:
ok did as you asked.


ok, the "selection change event" seems to not be firing off ?
fanpages-test1.bmp
0
FordraidersAuthor Commented:
ok...i redownloaded..

form is popping up now..(deal with modelesss later on my own)

As i go from row to row...form opens...
i then Closing the form after every row selection,

When the form pops up.. I hit the "sort" button,. but the mfgname showing in the blue form region...does not bubble to the top ?
0
FordraidersAuthor Commented:
aaaah i see what you did.... very very very very nice...
way above and beyond...this is really great !!!!!

got it to working now..
I see the selections at the bottom of the drop down list...
0
FordraidersAuthor Commented:
wow...wish i could offer more than 500. Points...I hope they change that one day for people who pay monthly premiums.

Very Nicely done...
0
[ fanpages ]IT Services ConsultantCommented:
No, thank you.

I enjoy the "out of the ordinary" requests, & new challenges.

There are only so many questions of a similar nature you can answer!

Glad I can help :)

BFN,

fp.

PS. I am not looking for additional points, but if you ever wish to award more to any "Expert", you can simply create a new question with, for instance, the title "Points for fanpages", describe why you are awarding additional points, & then just wait for the specific "Expert" to comment so you can select that as the solution.

For example:
[ http://www.experts-exchange.com/searchResults.jsp?searchTerms=POINTS+FOR+FANPAGES&searchSubmit= ]
0
FordraidersAuthor Commented:
Thanks again very much !
0
FordraidersAuthor Commented:
just sent additional question for you for extra points ..
0
[ fanpages ]IT Services ConsultantCommented:
It appears doing this is no longer accepted.

Sorry if I embarrassed you, fordraiders.
0
FordraidersAuthor Commented:
fanpages,
I have another revision for this question:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28318945.html

Thanks
fordraiders
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.