Sorting by custom aplphabet

[Ani]

i want to sort my selected text data bu pre-defined alphabet (albanian).
Albanian alphabet contains letters which are combination of 2 letters like "sh" "th" "gj" and those combinations must always count as a single letter.
Albanian alphabet letters order is given below:


a, b, c, ç, d, dh, e, ë, f, g, gj, h, i, j, k, l, ll, m, n, nj, o, p, q, r, rr, s, sh, t, th, u, v, x, xh, y, z, zh.




If i have multiple columns selected i would like to choose which column i sort and the other column is sorted so each row data is unchanged, but i can easily do that with lookups so that is not that important.
Thank you

[mancubus]

i think below code will not work since a custom list means something like "robert, jane, albert, bo" and ascending custom sort will place robert's at top, jane's at second, albert's at third, etc and not words start with r or j or a...
but i will not delete my post because it may give an idea.

try to post a workbook which contains words from local alphabet.


?


Sub vbax_62188_sort_custom_list()

With Application
.AddCustomList ListArray:=Array("a", " b", " c", " ç", " d", " dh", " e", " ë", " f", " g", " gj", " h", " i", " j", " k", " l", " ll", " m", " n", " nj", " o", " p", " q", " r", " rr", " s", " sh", " t", " th", " u", " v", " x", " xh", " y", " z", " zh")
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=.CustomListCount
.DeleteCustomList ListNum:=.CustomListCount
End With

End Sub


this code is for activesheet. add worksheet reference befoe A1's.

[Ani]

I attached a file containing names of cities and villages in Albania.

The most significant check is that all names starting with "Sh" should be after the names starting with "S".

I hope this helps anyone trying to help me

And thank you in advance

[Ani]

Thank you.
I know custom listing will not help me on this.
And yes your code helps me trying to figure out how to solve this.
Again thank you!

[Ani]

I did find a workaround/solution.



Option Explicit
Option Base 1


Sub Sort_Shqip()
Dim rng As Range
Dim i, j, iterator As Integer
Dim replaceArr(11, 2) As String
i = 11 'can change for other languages
j = 2

Set rng = Selection
''' hard coded data can change for different languages
replaceArr(1, 1) = "ç"
replaceArr(1, 2) = "czz"
replaceArr(2, 1) = "dh"
replaceArr(2, 2) = "dzz"
replaceArr(3, 1) = "ë"
replaceArr(3, 2) = "ezz"
replaceArr(4, 1) = "gj"
replaceArr(4, 2) = "gzz"
replaceArr(5, 1) = "ll"
replaceArr(5, 2) = "lzz"
replaceArr(6, 1) = "nj"
replaceArr(6, 2) = "nzz"
replaceArr(7, 1) = "rr"
replaceArr(7, 2) = "rzz"
replaceArr(8, 1) = "sh"
replaceArr(8, 2) = "szz"
replaceArr(9, 1) = "th"
replaceArr(9, 2) = "tzz"
replaceArr(10, 1) = "xh"
replaceArr(10, 2) = "xzz"
replaceArr(11, 1) = "zh"
replaceArr(11, 2) = "zzz"
For iterator = 1 To i
rng.Replace _
What:=replaceArr(iterator, 1), Replacement:=replaceArr(iterator, 2), _
SearchOrder:=xlByColumns, MatchCase:=False
Next iterator
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending
For iterator = 1 To i
rng.Replace _
What:=replaceArr(iterator, 2), Replacement:=replaceArr(iterator, 1), _
SearchOrder:=xlByColumns, MatchCase:=False
Next iterator
End Sub


This seems to perform very good. Anyway will leave this post open for one more day hoping to find help to make this code work for other ranges other than A1. and also make it work for multiple column sorting by selecting based on which column within a prompt.

[Ani]

a little improvement to make it work for any selecte range
Replace in row: "Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending"
With:

rng.CurrentRegion.Sort Key1:=rng, Order1:=xlAscending

[mancubus]

you can use a predifened 2D array for the conversion of the local letters

you may think of matrix.
comma , means next column and semicolon ; means next row.
the square brackets [ and ] are a shortcut to the evaluate method.



Sub vbax_62188_sort_on_local_alphabet()

Dim i As Long
Dim replaceArr

ReDim replaceArr(1 To 11, 1 To 2)
replaceArr = [{"ç","czzz";"dh","dzzz";"ë","ezzz";"gj","gzzz";"ll","lzzz";"nj","nzzz";"rr","rzzz";"sh","szzz";"th","tzzz";"xh","xzzz";"zh","zzzz"}]

With Range("A1").CurrentRegion
For i = 1 To 11
.Replace replaceArr(i, 1), replaceArr(i, 2)
Next i

.Sort Key1:=Range("A1"), Order1:=xlAscending

For i = 1 To 11
.Replace replaceArr(i, 2), replaceArr(i, 1)
Next i
End With

End Sub