custom sort

[charly1]

Hi

I have 2 user form list boxes each containing two columns of data. The first columns of both list boxes are identically, albeit sorted differently.

How can I write a code that would sort the second list box based on its first column, so that it matches up to the sort order of the first list box.

Thank you so much in advance for any help.

 

[Herakles]

Hi

I have 2 user form list boxes each containing two columns of data. The first columns of both list boxes are identically, albeit sorted differently.

How can I write a code that would sort the second list box based on its first column, so that it matches up to the sort order of the first list box.

Thank you so much in advance for any help.

Does the data come from a worksheet?

 

[charly1]

Yes. the first columns in the list boxes correspond to the first column of a data table, which contain unique reference numbers. The other column in each of the two list boxes are two other columns in the same table.

 

[Herakles]

Yes. the first columns in the list boxes correspond to the first column of a data table, which contain unique reference numbers. The other column in each of the two list boxes are two other columns in the same table.

Are you able to sort the data in the table and then repopulate the listboxes?

 

[charly1]

Unfortunately not.

 

[Herakles]

Unfortunately not.

Have you got access to the code that populates the listboxes?

Can you edit and add to the code on the userform.

 

[charly1]

yes.

[I was thinking of somehow copying the first column of list box 1 to list box 2, and then using some sort of lookup function to repopulate the second list box with the required column of data from the table].

 

[Herakles]

yes.

[I was thinking of somehow copying the first column of list box 1 to list box 2, and then using some sort of lookup function to repopulate the second list box with the required column of data from the table].

Can you :

1. Use XL2BB to post the table data.

2. VBA Quick Wrap selection to post the code that populates the listboxes.

 

[charly1]

1. The table has more than 3000 cells.
I have posted a sample below.

מספר	תוך ספר	עמודן	מדף	ספר	חלקים	נושא כללי	נושא פרטי	נושא שלישי	נושא כללי שני	נושא פרטי שני	נושא שלישי שני	תוכן	מחבר	פרטי המחבר	Blank Data	Blank Place	Both Blank	SumShelf	Column1
1	-	כט	7	תתן אמת ליעקב	1	הלכה	נושאים שונים	שונים	-	-	-	ליקוטים בעניני אמת ושקר.	ר' יעקב יחזקאל פיש	-				כט - 7	כט - 7
2	-	כט	2	תתאה ועילאה	1	הלכה	יו"ד: פ"ז-קי"א [תערובות ובב"ח], יו"ד: קכ"ג-קנ"ח\קע"ח-קפ"ב [עכו"ם]	יו"ד	-	-	-	דיני בישול ובליעות בכלים.	ר' משה ישראל רבינוביץ	אחרוני זמנינו				כט - 2	כט - 2
3	-			תשעה ספרי מוסר	1	מחשבה_ומוסר	-	מחשבה_ומוסר	-	-	-	כולל ספרי: אמרות טהורות, מבחר פנינים, החסיד יוסף יעב"ץ, איגרת הטיול, ארחות חיים, מעלות התורה, כתר תורה, ראש הגבעה, מנחת שמואל.	-	-		Missing Data	Missing Data
4	שבעה ספרים	לו	8	תשועות חיים	0	תורה	-	תורה	-	-	-	ליקוטים מחז"ל מיוסד עפרש"י, ביאורי המקראות עפ"י הראשונים, ופרטי שמות היוצאים מראשי וסופי תיבות הפסוקים.	ר' חיים ישעיה הכהן האלברסברג	אחרונים (ה' תרד-ה' תרע / 1844-1910)				שבעה ספרים [לו - 8]	תוך
5	ספרי בעל הפרדס	לו	7	תשובת מהרא"ל	0	שו_ת	-	שו"ת	-	-	-	-	ר' אריה ליב עפשטיין	גדולי האחרונים (ה' תסח-ה' תקלה / 1708-1775)				ספרי בעל הפרדס [לו - 7]	תוך

2.

Dim Ary As Variant, Rws As Variant
   Dim TBVal As String
   Dim Ws As Worksheet

  
  
   Set Ws = Sheets("îôúç")
   TBVal = TextBox1.Value
   With Ws.ListObjects("Table1").DataBodyRange
      If TBVal = "" Then
         Ary = Ws.Evaluate("choosecols(" & .Address & " ,1 ,5, 7, 14, 20)")
      Else
         TBVal = Replace(TBVal, Chr(34), Chr(34) & Chr(34))
         Rws = Filter(Ws.Evaluate(Replace("transpose(if(isnumber(search(""" & TBVal & """,@)),row(@)-min(row(@))+1,""X""))", "@", .Columns(5).Address)), "X", False)
         If UBound(Rws) < 0 Then
            Me.ListBox1.List = Array("No matches")
            Exit Sub
         ElseIf UBound(Rws) = 0 Then
            ReDim Preserve Rws(1)
         End If
         Ary = Application.Index(.Value, Application.Transpose(Rws), Array(1, 5, 7, 14, 20))
      End If
   End With
   

   
   With Me.ListBox1
      .ColumnCount = UBound(Ary, 2)
      .List = Ary
   End With

 

[charly1]

Private Sub CommandButton2_Click()
Dim searchrange As Range
Set searchrange = Worksheets("מפתח").ListObjects("Table1").ListColumns(1).DataBodyRange
Dim tableData As Range
Set tableData = Worksheets("מפתח").ListObjects("Table1").ListColumns(14).DataBodyRange
Dim Rr As Long
Dim Bb As Long
Bb = (ListBox1.ListCount - 1)
For Rr = 0 To Bb
With ListBox7
.ColumnCount = 2
.AddItem
.List(Rr, 0) = ListBox1.List(Rr, 0)
Dim c As String
c = WorksheetFunction.XLookup(ListBox1.List(Rr, 0), searchrange, tableData)
.List(Rr, 1) = c
End With
Next





End Sub