Public StartRange As Long Public EndRange As Long Public IntersectRange As Range Public OffsetRange As Range Public SourceC As Long Public TargetC As Long Public SortType As Long Sub SortCodeGenerator() Dim S As Variant Dim E As Variant Dim SC As Variant Dim TC As Variant Dim ST As Variant S = 0 E = 0 SC = 0 TC = 0 ST = 0 SourceC = 0 TargetC = 0 StartRange = 0 EndRange = 0 SortType = 0 ' Get SourceC value from User Do While SourceC = 0 SC = InputBox("Enter column NUMBER for source values", "Source Column") If IsNumeric(SC) Then SourceC = SC Else MsgBox ("Value must be an integer") End If Loop ' Get TargetC value from User Do While TargetC = 0 TC = InputBox("Enter column NUMBER for target values", "Target Column") If IsNumeric(TC) Then TargetC = TC Else MsgBox ("Value must be an integer") End If Loop ' Get StartRow value from User Do While StartRange = 0 S = InputBox("Enter the row for the start of the range", "Start Row") If IsNumeric(S) Then If S < 10 Then S = "0" & S StartRange = S Else MsgBox ("Value must be an integer") End If Loop ' Get EndRow value from User Do While EndRange = 0 E = InputBox("Enter the row for the end of the range", "End Row") If IsNumeric(E) Then If E < 10 Then E = "0" & E If E > S Then EndRange = E Else If E = S Then EndRange = E Else MsgBox ("Problem! " & E & " is less than " & S) MsgBox ("End row value must be greater than or equal to start row value") End If End If Else MsgBox ("Value must be an integer") End If Loop ' Get SortType value from User Do While SortType = 0 ST = InputBox("Enter number for Sort Type: 1 = Sanskrit; 2 = Gandhari; 3 = Absolute", "Source Column") If IsNumeric(ST) Then If ST < 4 Then SortType = ST Else MsgBox ("Please enter a number from 1 to 3") End If Else MsgBox ("Value must be an integer") End If Loop Call Gand2SortCode End Sub Private Sub Gand2SortCode() Dim Gand As Variant Dim R As Integer 'Call CallDialogBox R = StartRange Do Until R = EndRange + 1 Gand = Cells(R, SourceC) Gand = "'" & Gand Cells(R, TargetC) = Gand R = R + 1 Loop Call Sortcoder Call InsertDecimal Cells(EndRange, TargetC).Select End Sub Private Sub Sortcoder() Dim Gandhari As Variant Dim Len1 As Variant Dim UTF_1 As Variant Dim UTF_2 As Variant Dim UTF_3 As Variant Dim UTF_4 As Variant Dim SortTrue As Variant Dim SortSkt As Variant Dim SortGandh As Variant Dim NumSource As Variant Dim NumMid As Variant Dim NumCode As Variant Dim Quotes As Variant Dim Anusvara As Variant Dim ClassNasal As Variant Dim K As Variant Dim L As Variant Dim R As Integer 'Row Dim S As Integer 'Sort array Dim N As Integer 'Num array R = 2 S = 1 N = 1 Len1 = Array(3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) UTF_1 = Array(5000, 114, 108, 7789, 97, 117, 114, 108, 97, 97, 107, 103, 7713, 103, 99, 99, 106, 106, 106, 7789, 7693, 116, 100, 110, 112, 98, 109, 118, 347, 347, 7779, 115, 115, 104, 124, 126, 126, 97, 257, 105, 239, 299, 117, 252, 363, 101, 551, 111, 7747, 7717, 107, 7729, 103, 7713, 7749, 99, 106, 241, 7789, 7693, 7751, 116, 7791, 100, 7695, 110, 112, 7765, 98, 109, 121, 253, 114, 108, 118, 347, 7779, 115, 122, 104, 8226, 9702, 9675, 8712, 9784, 10057, 124, 8967, 12336, 45, 8730, 91, 93, 40, 41, 9001, 9002, 47, 39, 61, 43, 713, 728, 59450, 59585) UTF_2 = Array(5000, 805, 805, 769, 858, 858, 805, 805, 105, 117, 104, 817, 817, 104, 772, 104, 772, 769, 104, 104, 104, 104, 104, 772, 104, 104, 772, 769, 817, 772, 772, 817, 772, 772, 124, 42, 63) UTF_3 = Array(5000, 772, 772, 104) UTF_4 = Array(5000, 48) SortTrue = Array(5000, 19, 21, 48, 11, 16, 18, 20, 24, 26, 31, 33, 35, 36, 39, 40, 42, 43, 44, 47, 50, 54, 57, 59, 62, 64, 66, 72, 74, 75, 77, 79, 79, 82, 98, "", "", 10, 12, 13, 13, 14, 15, 15, 17, 22, 23, 25, 27, 28, 29, 30, 32, 34, 37, 38, 41, 45, 46, 49, 51, 52, 53, 55, 56, 58, 60, 61, 63, 65, 67, 68, 69, 70, 71, 73, 76, 78, 80, 81, 91, 92, 93, 94, 95, 96, 97, 99, 99, "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "") SortSkt = Array(5000, 19, 21, 47, 10, 15, 18, 20, 24, 26, 31, 32, 32, 36, 39, 40, 41, 41, 44, 47, 50, 54, 57, 58, 62, 64, 65, 71, 73, 73, 76, 78, 78, 82, 98, "", "", 10, 12, 13, 13, 14, 15, 15, 17, 22, 22, 25, 27, 28, 29, 29, 32, 32, 37, 38, 41, 45, 46, 49, 51, 52, 52, 55, 55, 58, 60, 60, 63, 65, 67, 67, 69, 70, 71, 73, 76, 78, 80, 81, 91, 92, 93, 94, 95, 96, 97, 99, 99, "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "") SortGandh = Array(5000, 18, 20, 47, 10, 15, 18, 20, 22, 25, 31, 32, 32, 36, 39, 40, 41, 41, 44, 47, 50, 54, 57, 58, 62, 64, 65, 71, 73, 73, 76, 78, 78, 82, 98, "", "", 10, 10, 13, 13, 13, 15, 15, 15, 22, 22, 25, 27, 28, 29, 29, 32, 32, 37, 38, 41, 45, 46, 49, 51, 52, 52, 55, 55, 58, 60, 60, 63, 65, 67, 67, 69, 70, 71, 73, 76, 78, 80, 81, 91, 92, 93, 94, 95, 96, 97, 99, 99, "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "") NumSource = Array(Q, 1000, 100, 20, 10, 4, 3, 2, 1) NumMid = Array(5000, 5001, 5002, 5003, 5004, 5005, 5006, 5007, 5008) NumCode = Array(Q, 90, 89, 88, 87, 86, 85, 84, 83) Quotes = Array(Q, "�", "�", "�", "�", "<", ">", "~?", ".") Anusvara = Array(5000, 107, 7729, 103, 7713, 7749, 99, 106, 241, 7789, 7693, 7751, 116, 7791, 100, 7695, 110, 112, 7765, 98, 109) ClassNasal = Array(5000, 7749, 7749, 7749, 7749, 7749, 241, 241, 241, 7751, 7751, 7751, 110, 110, 110, 110, 110, 109, 109, 109, 109) K = "Cells(StartRange, TargetC), Cells(EndRange, TargetC)" 'Anusvara to Class nasal Do Until S = 21 Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(7747) & ChrW(Anusvara(S)), Replacement:=ChrW(ClassNasal(S)) & ChrW(Anusvara(S)), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False S = S + 1 Loop 'Replace Letters And punctuation If SortType = 1 Then Do Until S = 104 If Len1(S) = 3 Then Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(UTF_1(S)) & ChrW(UTF_2(S)) & ChrW(UTF_3(S)), Replacement:=SortSkt(S), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End If If Len1(S) = 2 Then Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(UTF_1(S)) & ChrW(UTF_2(S)), Replacement:=SortSkt(S), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End If If Len1(S) = 1 Then Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(UTF_1(S)), Replacement:=SortSkt(S), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End If Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:="1000", Replacement:=ChrW(5001), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False S = S + 1 Loop Else If SortType = 2 Then Do Until S = 104 If Len1(S) = 3 Then Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(UTF_1(S)) & ChrW(UTF_2(S)) & ChrW(UTF_3(S)), Replacement:=SortGandh(S), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End If If Len1(S) = 2 Then Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(UTF_1(S)) & ChrW(UTF_2(S)), Replacement:=SortGandh(S), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End If If Len1(S) = 1 Then Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(UTF_1(S)), Replacement:=SortGandh(S), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End If Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:="1000", Replacement:=ChrW(5001), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False S = S + 1 Loop Else If SortType = 3 Then Do Until S = 104 If Len1(S) = 3 Then Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(UTF_1(S)) & ChrW(UTF_2(S)) & ChrW(UTF_3(S)), Replacement:=SortTrue(S), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End If If Len1(S) = 2 Then Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(UTF_1(S)) & ChrW(UTF_2(S)), Replacement:=SortTrue(S), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End If If Len1(S) = 1 Then Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(UTF_1(S)), Replacement:=SortTrue(S), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End If Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:="1000", Replacement:=ChrW(5001), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False S = S + 1 Loop End If End If End If 'Replace Mid Numbers to Code Do Until N = 9 Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(NumMid(N)), Replacement:=NumCode(N), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False N = N + 1 Loop 'Replace quotation marks N = 1 Do Until N = 9 Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=Quotes(N), Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False N = N + 1 Loop 'Replace macron double breve Range(Cells(StartRange, TargetC), Cells(EndRange, TargetC)).Select Selection.Replace What:=ChrW(59585), Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False End Sub Sub InsertDecimal() Dim A As Variant Dim B As Variant Dim C As Variant Dim R As Integer R = StartRange Do Until R = EndRange + 1 A = Cells(R, TargetC) If Len(A) > 2 Then B = Left(A, 2) C = Right(A, Len(A) - 2) A = "'" & B & "." & C Else A = "'" & A End If Cells(R, TargetC) = A R = R + 1 Loop End Sub