Custom sort in unique alphabetical order

Question

I am trying to do a custom sort in a unique alphabetical order to be precise in below order. A vba solution is preferred.

A, P, R, C, D, E, F, G, H, I, J, K, L, M, O, Q, S, T, U, V, W, X, Y, Z, B, N

Thanks Suji

Answer 1

It is simple task:

1. Define array with your custom ordering
2. Based on that array do the comparison: find indexes of letters and return difference of those indexes, then if the resut is >0 then second parameter is greater, <0 - first is greater, =0 - both are equal.

See below code:

Option Explicit

Sub CustomOrder()
    MsgBox CustomComparer("Z", "B") 'shows 1, so B is greater
End Sub

Function CustomComparer(str1 As String, str2 As String) As Long
    Dim orderArray As Variant
    orderArray = Array("A", "P", "R", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "O", "Q", "S", "T", "U", "V", "W", "X", "Y", "Z", "B", "N")

    Dim isFirstFound As Boolean, isSecondfound As Boolean, i As Long, firstIndex As Long, secondIndex As Long

    For i = LBound(orderArray) To UBound(orderArray)
        If str1 = orderArray(i) Then
            firstIndex = i
            isFirstFound = True
        End If
        If str2 = orderArray(i) Then
            secondIndex = i
            isSecondfound = True
        End If
        If isFirstFound And isSecondfound Then Exit For
    Next

    CustomComparer = secondIndex - firstIndex
End Function