VBa code to align rows with english text

R

Ramadan

Banned User
Joined
Jan 20, 2024
Messages
93
Office Version
  1. 2021
Platform
  1. Windows
I'm working on excel worksheet with a large table that might contain English and other languages text only in column "E" and alignment for each row manually take alot of work
and I'm looking for macro to perform this task

I have created this simple rules to just align rows but I don't know how to add a rule says if the cell contains english string otherwise make alignment right to left
can you please add such rule to my code or suggest a better one

Thanks in advance


VBA Code: 
[
Sub Align()

Range("E:E").HorizontalAlignment = xlLeft
Range("E:E").VerticalAlignment = xlCenter


End Sub]
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
@Ramadan2512 what language do you wish to "detect"?
It will be easier to set a codepage to look for than just setting all non-english characters.

Can you please tell which language(s) you are using other than english?
 
Upvote 0
I'm just guessing that you narrowed the topic too much to English. As I understand it, it's more about differentiating between left-to-right or right-to-left text writing systems, depending on the language used.
Theoretically, if the cells have horizontal formatting set to General, texts written in different systems should automatically be pulled to the appropriate cell edge. So the macro seems unnecessary.

If the macro is necessary, below is the code to be placed in the sheet module (not in the standard module!). This is an event procedure that examines the changed cells in column E. Every character in each cell examined is checked. If the macro encounters a character belonging to the characters of the “right-to-left” system, the cell is formatted with the text pulled to the right. If no character belongs to the ranges listed in the function, the macro considers that we are dealing with the “left-to-right” system and the text will be pulled to the left edge of the cell.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim Cell As Range
    Dim CellValue As Variant
    Dim i As Long
    Dim IsRightToLeftLanguage As Boolean
    
    Set Rng = Intersect(Target, Me.Columns("E").Cells)
    
    If Not Rng Is Nothing Then
        Application.EnableEvents = True
        
        For Each Cell In Rng
            CellValue = Cell.Value
            
            If Not IsNumeric(CellValue) Then
                For i = 1 To Len(CellValue)
                    If IsRightToLeftLanguageChar(Mid(CellValue, i, 1)) Then
                        IsRightToLeftLanguage = True
                        Exit For
                    End If
                Next i
            End If
            
            If IsRightToLeftLanguage Then
                Cell.HorizontalAlignment = xlRight
            Else
                Cell.HorizontalAlignment = xlLeft
            End If
            
            Cell.VerticalAlignment = xlCenter
        Next Cell
        
        Application.EnableEvents = True
    End If
End Sub


Private Function IsRightToLeftLanguageChar(ch As String) As Boolean
    Dim code As Long

    code = AscW(ch)

    ' Checking whether the character code belongs to one of the ranges

    'languages:
    '           Arabic, Persian(Farsi), Urdu, Pashto &H600-&H6FF
    '           Hebrew &H590-&H5FF
    '           Syrian(Aramaic) &H700-&H74F
    IsRightToLeftLanguageChar = ((code >= &H600 And code <= &H6FF) Or _
                                 (code >= &H590 And code <= &H5FF) Or _
                                 (code >= &H700 And code <= &H74F))
End Function
Artik
 
Upvote 0
PeteWright said:
@Ramadan2512 what language do you wish to "detect"?
It will be easier to set a codepage to look for than just setting all non-english characters.

Can you please tell which language(s) you are using other than english?
Click to expand...
languages are English and Arabic
 
Upvote 0
Artik said:
I'm just guessing that you narrowed the topic too much to English. As I understand it, it's more about differentiating between left-to-right or right-to-left text writing systems, depending on the language used.
Theoretically, if the cells have horizontal formatting set to General, texts written in different systems should automatically be pulled to the appropriate cell edge. So the macro seems unnecessary.

If the macro is necessary, below is the code to be placed in the sheet module (not in the standard module!). This is an event procedure that examines the changed cells in column E. Every character in each cell examined is checked. If the macro encounters a character belonging to the characters of the “right-to-left” system, the cell is formatted with the text pulled to the right. If no character belongs to the ranges listed in the function, the macro considers that we are dealing with the “left-to-right” system and the text will be pulled to the left edge of the cell.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim Cell As Range
    Dim CellValue As Variant
    Dim i As Long
    Dim IsRightToLeftLanguage As Boolean
  
    Set Rng = Intersect(Target, Me.Columns("E").Cells)
  
    If Not Rng Is Nothing Then
        Application.EnableEvents = True
      
        For Each Cell In Rng
            CellValue = Cell.Value
          
            If Not IsNumeric(CellValue) Then
                For i = 1 To Len(CellValue)
                    If IsRightToLeftLanguageChar(Mid(CellValue, i, 1)) Then
                        IsRightToLeftLanguage = True
                        Exit For
                    End If
                Next i
            End If
          
            If IsRightToLeftLanguage Then
                Cell.HorizontalAlignment = xlRight
            Else
                Cell.HorizontalAlignment = xlLeft
            End If
          
            Cell.VerticalAlignment = xlCenter
        Next Cell
      
        Application.EnableEvents = True
    End If
End Sub


Private Function IsRightToLeftLanguageChar(ch As String) As Boolean
    Dim code As Long

    code = AscW(ch)

    ' Checking whether the character code belongs to one of the ranges

    'languages:
    '           Arabic, Persian(Farsi), Urdu, Pashto &H600-&H6FF
    '           Hebrew &H590-&H5FF
    '           Syrian(Aramaic) &H700-&H74F
    IsRightToLeftLanguageChar = ((code >= &H600 And code <= &H6FF) Or _
                                 (code >= &H590 And code <= &H5FF) Or _
                                 (code >= &H700 And code <= &H74F))
End Function
Artik
Click to expand...
thanks for your reply and being patient to write a long code for me but unfortuntely I added it to the sheet and uncommented arabic languge as I'm using English and Arabic but nothing changed
 
Last edited by a moderator:
Upvote 0
Artik said:
I'm just guessing that you narrowed the topic too much to English. As I understand it, it's more about differentiating between left-to-right or right-to-left text writing systems, depending on the language used.
Theoretically, if the cells have horizontal formatting set to General, texts written in different systems should automatically be pulled to the appropriate cell edge. So the macro seems unnecessary.

If the macro is necessary, below is the code to be placed in the sheet module (not in the standard module!). This is an event procedure that examines the changed cells in column E. Every character in each cell examined is checked. If the macro encounters a character belonging to the characters of the “right-to-left” system, the cell is formatted with the text pulled to the right. If no character belongs to the ranges listed in the function, the macro considers that we are dealing with the “left-to-right” system and the text will be pulled to the left edge of the cell.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim Cell As Range
    Dim CellValue As Variant
    Dim i As Long
    Dim IsRightToLeftLanguage As Boolean
 
    Set Rng = Intersect(Target, Me.Columns("E").Cells)
 
    If Not Rng Is Nothing Then
        Application.EnableEvents = True
     
        For Each Cell In Rng
            CellValue = Cell.Value
         
            If Not IsNumeric(CellValue) Then
                For i = 1 To Len(CellValue)
                    If IsRightToLeftLanguageChar(Mid(CellValue, i, 1)) Then
                        IsRightToLeftLanguage = True
                        Exit For
                    End If
                Next i
            End If
         
            If IsRightToLeftLanguage Then
                Cell.HorizontalAlignment = xlRight
            Else
                Cell.HorizontalAlignment = xlLeft
            End If
         
            Cell.VerticalAlignment = xlCenter
        Next Cell
     
        Application.EnableEvents = True
    End If
End Sub


Private Function IsRightToLeftLanguageChar(ch As String) As Boolean
    Dim code As Long

    code = AscW(ch)

    ' Checking whether the character code belongs to one of the ranges

    'languages:
    '           Arabic, Persian(Farsi), Urdu, Pashto &H600-&H6FF
    '           Hebrew &H590-&H5FF
    '           Syrian(Aramaic) &H700-&H74F
    IsRightToLeftLanguageChar = ((code >= &H600 And code <= &H6FF) Or _
                                 (code >= &H590 And code <= &H5FF) Or _
                                 (code >= &H700 And code <= &H74F))
End Function
Artik
Click to expand...
I don't know if this can simplify the code needed ( I can manually align all the column cells right to left but at least the code can only align cells with english text left to right) or to align all cells left ot right and the code to select arabic text to be right to left- is that ok?
 
Upvote 0
See if this works as you want.
Code: 
Sub test()
    Dim r As Range, flg As Boolean
    For Each r In Range("e1", Range("e" & Rows.Count).End(xlUp))
        flg = r Like "*[a-zA-Z$@$!%*?&#^-_.+]*"
        r.HorizontalAlignment = IIf(flg, xlLeft, xlRight)
    Next
End Sub
 
Upvote 0
Solution
Fuji said:
See if this works as you want.
Code: 
Sub test()
    Dim r As Range, flg As Boolean
    For Each r In Range("e1", Range("e" & Rows.Count).End(xlUp))
        flg = r Like "*[a-zA-Z$@$!%*?&#^-_.+]*"
        r.HorizontalAlignment = IIf(flg, xlLeft, xlRight)
    Next
End Sub
Click to expand...
Wow - this is very simple and perfect - thank you so much it works smoothly - Thanks Fuji - great
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Proper syntax for horizonal alignment within a column
Replies
2
Views
83
pelkbc5172
P
Y
  • Solved
Issue with HorizontalAlignment
Replies
8
Views
555
Peter_SSs
Peter_SSs
W
  • Solved
VBA - Match two values from Table1 to two in Table2 and move/align
2
Replies
15
Views
497
Welshy1491
W
A
  • Question Question
[Excel / VBA] How do align some columns exporting to TXT?
Replies
3
Views
342
Joe4
Joe4
I
  • Question Question
Add ID number next to customer row from userform transfer
Replies
2
Views
332
Joe4
Joe4

Forum statistics

Threads
1,225,624
Messages
6,186,068
Members
453,336
Latest member
Excelnoob223

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top