Assigning values

[Azarudeen]

Hi All,


I have a excel like below in the C column and D column


C D

ا A
ء A
ب B
ت T
ث TH
ج J
ح H
خ KH
د D
ذ DH
ر R
ز Z
س S
ش SH
ص S
ض D
ط T
ظ Z
ع A
غ GH
ف F
ق Q
ك KH
ل L
م M
ن N
ه H
ة H
و W
ي Y
ى Y
لا LA
ال AL




I want to write a macro that whenever I type ا this needs to be changed to A in the column A and B.
If I change/add anything in C column, it should work.


Can someone help me on this.

 

[Azarudeen]

I am sorry for that. I didn't see the forum rules.

This is urgent that is the reason I posted there also.

Henceforth this wont be happened.

 

[Azarudeen]

First of all I am sorry for that.

Is it possible if type 2 or more symbols in the single cell and will it be converted to corresponding letters.

Ex: If I type اب in "A" column, it will be converted to AB in "B" column.

I would like to write code that If i multiple letter it should be converted to corresponding letters. Please help me

 

[MickG]

Your Latest request is a bit confusing,re:- Where do you want the response "A or B" ???

This code will convert Multiple characters in a single cell, ref:-column "C" to their related Letters from Column "D".

Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] t
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
[COLOR=Navy]If[/COLOR] Intersect(Target, Rng.Resize(, 2)) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
 [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
  Dic.CompareMode = vbTextCompare
   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng: Dic(Dn.Value) = Dn.Offset(, 1): [COLOR=Navy]Next[/COLOR]
    [COLOR=Navy]For[/COLOR] n = 1 To Len(Target)
        [COLOR=Navy]If[/COLOR] Dic.exists(Target.Characters(n, 1).Text) [COLOR=Navy]Then[/COLOR] Target.Characters(n, 1).Text = Dic.Item(Target.Characters(n, 1).Text)
    [COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[Azarudeen]

Thanks Mick its working perfectly fine now that if i type 2 or more symbols, it is converting to corresponding letters.

But If I add the below symbols also in excel(in the Cell C and D) and runs the above code, it shows incorrect value.

C D

اَ	A
اِ	E
اُ	Vu
اً	An

<colgroup><col width="64" span="2" style="width: 48pt;"></colgroup><tbody>
</tbody>

For ex: If i type اً in one cell, it should be converted to An but it shows as Aً.

 

[MickG]

Unfortunately that seems more to do with "Excel's" interpretation of the specific character, than of the code.
The are other characters that also show discrepancies!!!!

 

[Azarudeen]

But when I use the same symbols in your previous code, it is showing correct value.

For Ex: If I type اً in one cell, it is converting to An correctly.

Previous Code:

Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object[COLOR=Navy]Set[/COLOR] Rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))[COLOR=Navy]If[/COLOR] Intersect(Target, Rng.Resize(, 2)) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")  Dic.CompareMode = vbTextCompare   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng: Dic(Dn.Value) = Dn.Offset(, 1): [COLOR=Navy]Next[/COLOR]    [COLOR=Navy]If[/COLOR] Dic.exists(Target.Value) [COLOR=Navy]Then[/COLOR] Target = Dic.Item(Target.Value)[COLOR=Navy]End[/COLOR] If[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]</pre>

Is there anything that needs to be added in the new one inorder to avoid this

 

[MickG]

The problem appears to be the number of characters that comprise each Character set in column "C".
With the previous code there was just one characters set in the target cell, which could be related to All the Characters sets in column "C", in order to find the right character set.
When there are more than one Character that make up a character set, then it a job to know whether to look for one or more characters, and this causes the problem
Unfortunately I do not know how to solve it.
Perhaps someone else has a solution.

 

[Azarudeen]

Thanks Mick for your help so far.

Can someone help me that If I add the above symbols in excel(in the Cell C and D) and runs the above code, it shows incorrect value.

 

[MickG]

This is not perfect but give it a try.
Its best to enter one letter at a time !!!
NB:- Paste code at top of VB window

Option Explicit
Dim Str As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng         As Range
Dim Dn          As Range
Dim Dic         As Object
Application.EnableEvents = False
    If Target.Count = 1 Then
        Set Rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
            If Intersect(Target, Rng.Resize(, 2)) Is Nothing Then
                Set Dic = CreateObject("scripting.dictionary")
                    Dic.CompareMode = vbTextCompare
    For Each Dn In Rng: Dic(Dn.Value) = Dn.Offset(, 1): Next
        If Not Str = vbNullString Then
            If Dic.exists(Target.Value) Then
                Target.Value = Str & Dic.Item(Target.Value)
                Str = ""
            [A1] = 1
            Else
                Target.Value = Str & Target.Value
            End If
        Else
            If Dic.exists(Target.Value) Then
                Target.Value = Dic.Item(Target.Value)
            Else
                Target.Value = Target.Value
            End If
       End If
     End If
End If
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
    If Intersect(Target, Range("C:D")) Is Nothing Then
        Str = Target
    End If
End If
End Sub

 

[Azarudeen]

Yes Mick this is working only with single letter.

But if i type 2 or more symbols, it is not converting to corresponding letters. Now again this is also I need.

Is there any way to solve this one?