## Sort 1d array by letters weight

YasserKhalil
PlatinumLounger
Posts: 4851
Joined: 31 Aug 2016, 09:02

### Sort 1d array by letters weight

Hello everyone

In a previous topic at this link https://eileenslounge.com/viewtopic.php?f=30&t=38460
Mr. Hans offered a UDF that calculates the letters' weight

Code: Select all

``````Function Weight(s As String) As Long
Dim Letters, Weights
Dim i As Long
Letters = Array("A", "B", "C", ..., "Z")
Weights = Array(1, 5, 3, ..., 2)
For i = 1 To Len(s)
Weight = Weight + Weights(Asc(Mid(s, i, 1)) - 65)
Next i
End Function``````
I have UserForm1 with 6 listboxes that have words in each Listbox and on UserForm3 I have a Listbox where I could combine all the words from the six listboxes and display them on the UserForm3

What I need is to sort the words by letters' weight from top weight to lowest weight

Here's the command button code that I am using to collect the words from the listboxes on UserForm1

Code: Select all

``````Private Sub CommandButton3_Click()
Dim v, a(), i As Integer, ii As Integer, k As Long
k = 0
For i = 1 To 6
With Me.Controls("ListBox" & i)
If .ListCount > 0 Then
v = .List
For ii = LBound(v) To UBound(v)
ReDim Preserve a(k)
a(k) = v(ii, 0)
k = k + 1
Next ii
End If
End With
Next i
UserForm3.ListBox1.List = a
UserForm3.Show
End Sub
``````

YasserKhalil
PlatinumLounger
Posts: 4851
Joined: 31 Aug 2016, 09:02

### Re: Sort 1d array by letters weight

I have searched and found a solution and could modify it to suit my case
In standard module

Code: Select all

``````Public Sub CustomQuickSort(list() As String, first As Long, last As Long)
Dim pivot As String, low As Long, high As Long
low = first: high = last
pivot = list((first + last) \ 2)
Do While low <= high
Do While low < last And SortCompare(list(low), pivot)
low = low + 1
Loop
Do While high > first And SortCompare(pivot, list(high))
high = high - 1
Loop
If low <= high Then
Dim swap As String
swap = list(low)
list(low) = list(high)
list(high) = swap
low = low + 1
high = high - 1
End If
Loop
If (first < high) Then CustomQuickSort list, first, high
If (low < last) Then CustomQuickSort list, low, last
End Sub

Private Function SortCompare(one As String, two As String) As Boolean
Dim vOne, vTwo
vOne = Weight(one)
vTwo = Weight(two)
Select Case True
Case vOne < vTwo
SortCompare = False
Case vOne > vTwo
SortCompare = True
Case vOne = vTwo
SortCompare = LCase\$(one) < LCase\$(two)
End Select
End Function``````
In the command button on userform1 that displays UserForm3

Code: Select all

``````Private Sub CommandButton3_Click()
Dim v, a() As String, i As Integer, ii As Integer, k As Long
k = 0
For i = 1 To 6
With Me.Controls("ListBox" & i)
If .ListCount > 0 Then
v = .list
For ii = LBound(v) To UBound(v)
ReDim Preserve a(k)
a(k) = v(ii, 0)
k = k + 1
Next ii
End If
End With
Next i
CustomQuickSort a, LBound(a), UBound(a)
UserForm3.ListBox1.list = a
UserForm3.Show
End Sub
``````
I need to add another column in the listbox on UserForm3 that shows the result of the weight for each word