Split 1D array into two 1D arrays by language

[YasserKhalil]

Hello everyone

I have 1d array which has names (Arabic and English). I would like to split that array into 2 separate arrays (one for the Arabic names and the other for the English names)

Code: Select all

Sub Test()
    ReDim a(1 To 6)
    
    a(1) = "Ahmed"
    a(2) = "سالم"
    a(3) = "Yasser"
    a(4) = "احمد"
    a(5) = "Salem"
    a(6) = "Hans"
    
    
End Sub

Then I need to join the strings as for the Arabic language in the normal order but as for the English array to join the strings in reverse order
I mean as for the Arabic should be a(2) & a(4) like that [سالم احمد] and as for the English array, the final result would be [Hans Salem Yasser Ahmed]

[HansV]

Code: Select all

    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim b() As String
    Dim c() As String
    Dim d() As String
    For i = LBound(a) To UBound(a)
        If AscW(a(i)) >= &H600 Then
            j = j + 1
            ReDim Preserve b(1 To j)
            b(j) = a(i)
        Else
            k = k + 1
            ReDim Preserve c(1 To k)
            c(k) = a(i)
        End If
    Next i
    If k > 0 Then
        ReDim d(1 To k)
        For i = 1 To k
            d(i) = c(k + 1 - i)
        Next i
    End If

At the end, the array b will contain the Arabic names, the array c will contain the Western names in the original order, and the array d will contain the Western names in reverse order.

[YasserKhalil]

Amazing my tutor. Thank you very much for this perfect solution.

[DocAElstein]

Hi
Here is an alternative. It’s based on Hans coding, that is to say the way he did to separate the English and Arab words.

Code: Select all

Option Explicit'  https://eileenslounge.com/viewtopic.php?f=30&t=39197
Sub TestitPretty()
Dim Ay() As String:    ReDim Ay(1 To 6)
 Let Ay(1) = "Ahmed": Ay(2) = ChrW(1537): Ay(3) = "Yasser": Ay(4) = ChrW(1538): Ay(5) = "Satan": Ay(6) = "Hans"
    
Dim strEng As String, strArb As String, Cnt As Long
    For Cnt = 1 To UBound(Ay())
        If AscW(Ay(Cnt)) >= &H600 Then
         Let strArb = strArb & Cnt & " "
        Else
         Let strEng = strEng & Cnt & " "
        End If
    Next Cnt
Dim BeaV() As Variant, DieV() As Variant '
 Let BeaV() = Application.Index(Ay(), 1, Split(Left(strArb, Len(strArb) - 1))): DieV() = Application.Index(Ay(), 1, Split(StrReverse(Left(strEng, Len(strEng) - 1))))
End Sub






Sub Testit()
Dim Ay() As String:    ReDim Ay(1 To 6)
 
 Let Ay(1) = "Ahmed"
 Let Ay(2) = ChrW(1537) ' "????"
 Let Ay(3) = "Yasser"
 Let Ay(4) = ChrW(1538) ' "????"
 Let Ay(5) = "Satan"
 Let Ay(6) = "Hans"
    
Dim strEng As String, strArb As String
Dim Cnt As Long
    For Cnt = 1 To UBound(Ay())
        If AscW(Ay(Cnt)) >= &H600 Then
         Let strArb = strArb & Cnt & " "
        Else
         Let strEng = strEng & Cnt & " "
        End If
    Next Cnt
 Let strArb = Left(strArb, Len(strArb) - 1): strEng = Left(strEng, Len(strEng) - 1) ' Take last space off
 Let strEng = StrReverse(strEng)

Dim Bea() As String, Die() As String ' Split returns elements of string type
 Let Bea() = Split(strArb, " ", -1, vbBinaryCompare): Die() = Split(strEng, " ", -1, vbBinaryCompare)
Dim BeaV() As Variant, DieV() As Variant ' App Index returns Elements of variant type
 Let BeaV() = Application.Index(Ay(), 1, Bea()): DieV() = Application.Index(Ay(), 1, Die())
MsgBox Prompt:="In BeaV() is  " & Join(BeaV(), " ") & vbCr & vbLf & "In DeaV() is  " & Join(DieV(), " ")
End Sub

Alan.

[YasserKhalil]

Thank you very much Mr. Alan for sharing the topic.