Solved

# sorting listbox with additional information from current sheet

Posted on 2013-09-25
Medium Priority
435 Views
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
``````
0
Question by:Fordraiders
• 16
• 10

LVL 35

Expert Comment

ID: 39522851
(cough)

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

"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

LVL 3

Author Comment

ID: 39523646
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

LVL 3

Author Comment

ID: 39523649
0

LVL 35

Expert Comment

ID: 39523879
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

LVL 3

Author Comment

ID: 39525013
fanpages, here is the file
Q-28235471-REVISED-0926.xlsm
0

LVL 3

Author Comment

ID: 39532104
fanpages, is this data sufficient?
0

LVL 35

Expert Comment

ID: 39532528
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

LVL 3

Author Comment

ID: 39533316
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

LVL 35

Expert Comment

ID: 39536072
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

LVL 3

Author Comment

ID: 39537872
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

LVL 35

Expert Comment

ID: 39538011
:)

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

LVL 3

Author Comment

ID: 39538631
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
.ColumnCount = rst.Fields.Count
.Column = Arr
.ListIndex = -1
End With
example-listbox-and-sheet-mfgnam.bmp
0

LVL 35

Expert Comment

ID: 39539541
:)

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

LVL 3

Author Comment

ID: 39539801
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.
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

LVL 35

Accepted Solution

[ fanpages ] earned 2000 total points
ID: 39540281
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
``````

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

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,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.List(Me.ListBox1.ListCount - 1&, 6&) = lngLoop
Else
'        Me.ListBox1.AddItem Chr\$(Int(Rnd() * 26) + 65)

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
``````

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
``````

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.

Thank you.

BFN,

fp.
Q-28249788.xlsm
0

LVL 3

Author Comment

ID: 39541045
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

LVL 35

Expert Comment

ID: 39541066
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

LVL 3

Author Comment

ID: 39541120

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

LVL 3

Author Comment

ID: 39541135

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

LVL 3

Author Comment

ID: 39541164
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

LVL 3

Author Comment

ID: 39541174
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

LVL 35

Expert Comment

ID: 39541225
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!

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

LVL 3

Author Closing Comment

ID: 39541329
Thanks again very much !
0

LVL 3

Author Comment

ID: 39541338
just sent additional question for you for extra points ..
0

LVL 35

Expert Comment

ID: 39541655
It appears doing this is no longer accepted.

Sorry if I embarrassed you, fordraiders.
0

LVL 3

Author Comment

ID: 39720940
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

## Featured Post

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.