Sort 1d array by letters weight

[YasserKhalil]

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]

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