Extract Arabic or English words

[Geo Jul]

Dear ALL​

need help how to extract Arabic or English words from a list in excel 2010 or 2016​

many thanks in advance​

 

[Legacy 143009]

Check is this works:

Public Sub HighlightArabic()
  Dim cellCheck As Range
  Dim hasArabic As Boolean
  Dim i As Long, c As Long
  Dim lRow As Long
  Dim arabicList As Variant

  lRow = Cells(Rows.Count, "A").End(xlUp).Row
  Redim arabicList(1 To 1, 1 To 1)

  For Each cellCheck In Range("A1:A" & lRow)
    hasArabic = False
    For i = 1 To Len(cellCheck.Text)
        c = AscW(Mid(cellCheck.Text, i))
        If c >= &H600 And c <= &H6FF Then
            hasArabic = True
            Exit For
        End If
      Next i
      If hasArabic Then
        arabicList(1, Ubound(arabicList, 2)) = cellCheck.Value
        Redim Preserve arabicList(1 To 1, 1 To Ubound(arabicList, 2) + 1)
      End If
  Next
  Redim Preserve arabicList(1 To 1, 1 To Ubound(arabicList, 2) - 1)
  Range("B1").Resize(Ubound(arabicList, 2)).Value = Application.Transpose(arabicList)
End Sub

 

[Geo Jul]

Check is this works:

Public Sub HighlightArabic()
  Dim cellCheck As Range
  Dim hasArabic As Boolean
  Dim i As Long, c As Long
  Dim lRow As Long
  Dim arabicList As Variant

  lRow = Cells(Rows.Count, "A").End(xlUp).Row
  Redim arabicList(1 To 1, 1 To 1)

  For Each cellCheck In Range("A1:A" & lRow)
    hasArabic = False
    For i = 1 To Len(cellCheck.Text)
        c = AscW(Mid(cellCheck.Text, i))
        If c >= &H600 And c <= &H6FF Then
            hasArabic = True
            Exit For
        End If
      Next i
      If hasArabic Then
        arabicList(1, Ubound(arabicList, 2)) = cellCheck.Value
        Redim Preserve arabicList(1 To 1, 1 To Ubound(arabicList, 2) + 1)
      End If
  Next
  Redim Preserve arabicList(1 To 1, 1 To Ubound(arabicList, 2) - 1)
  Range("B1").Resize(Ubound(arabicList, 2)).Value = Application.Transpose(arabicList)
End Sub

Many thanks for your responses. Please, if possible, provide a formula

 

[Georgiboy]

The below is not an exact science but as long as your text always starts with a letter then the below may help. One option to try for Excel 2013> and one for Excel 2000>:

Book1
	A	B	C
1		Excel 2016 >	Excel 2000 >
2	hi	English	English
3	أهلاً	Not English	Not English
4	There	English	English
5	هناك	Not English	Not English
6	How	English	English
7	كيف	Not English	Not English
8	are	English	English
9	نكون	Not English	Not English
10	You	English	English
11	أنت	Not English	Not English
Sheet1

Cell Formulas
Range	Formula
B2:B11	B2	=IF(OR(AND(UNICODE(LEFT(A2,1))>64,UNICODE(LEFT(A2,1))<98),AND(UNICODE(LEFT(A2,1))>89,UNICODE(LEFT(A2,1))<123)),"English","Not English")
C2:C11	C2	=IF(CODE(LEFT(A2,1))<>63,"English","Not English")

 

[Geo Jul]

The below is not an exact science but as long as your text always starts with a letter then the below may help. One option to try for Excel 2013> and one for Excel 2000>:

Book1
	A	B	C
1		Excel 2016 >	Excel 2000 >
2	hi	English	English
3	أهلاً	Not English	Not English
4	There	English	English
5	هناك	Not English	Not English
6	How	English	English
7	كيف	Not English	Not English
8	are	English	English
9	نكون	Not English	Not English
10	You	English	English
11	أنت	Not English	Not English
Sheet1

Cell Formulas
Range	Formula
B2:B11	B2	=IF(OR(AND(UNICODE(LEFT(A2,1))>64,UNICODE(LEFT(A2,1))<98),AND(UNICODE(LEFT(A2,1))>89,UNICODE(LEFT(A2,1))<123)),"English","Not English")
C2:C11	C2	=IF(CODE(LEFT(A2,1))<>63,"English","Not English")

Many Thanks for your help and your responses.