Replacing each letter in string VBA

[craigg3]

I have a range of cells (B2:H10) that has different text within the cells and I would like to be able to use a key list to change each one of the letters to their corresponding key.

For example, cell B2, I may have the word "Animal", and in that cell I want A=H, n=J, i=t, m=G, a=T, l=y ....and the key list would go on throughout the alphabet and the same key would be used on the other cells. It would also need to be case sensitive (A=H, a=T) when replacing each letter with the key list. Also, each cell may have different lengths of characters or may even be an empty cell. Is this doable in VBA?

 

[mse330]

Hi @craigg3

Try the example below ... If the letter is not found in the keys list, it would show "", if that's not correct, what should it show ?

Sub test()

Dim a, b, Dic As Object, Txt$
Set Dic = CreateObject("scripting.dictionary")
a = Range("A2", Range("A" & Rows.Count).End(3))
b = Range("D2", Range("D" & Rows.Count).End(3)).Resize(, 2)


For x = 1 To UBound(b)
   If Not Dic.exists(b(x, 1)) Then Dic.Add b(x, 1), b(x, 2)
Next

For x = 1 To UBound(a)
   For i = 1 To Len(a(x, 1))
      Txt = Txt & Dic(Mid(a(x, 1), i, 1))
   Next
   a(x, 1) = Txt
   Txt = vbNullString
Next

[B2].Resize(UBound(a)) = a

End Sub

Book1
	A	B	C	D	E
1	Input	Output		Letter	Key
2	Animal	HJtGTy		A	H
3	mali	GTyt		n	J
4	mAn	GHJ		i	t
5				m	G
6				a	T
7				l	y
Sheet1

 

[Eric W]

Sure, open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to Insert a Module. Paste the following code in the window that opens:

Public Function ConvertText(t1 As String) As String
Dim i As Long, j As Long, SrcList As String, TrgList As String

    SrcList = "aAbBcCxXyYzZ"
    TrgList = "PtCefGHikLmn"
    
    For i = 1 To Len(t1)
        j = InStr(SrcList, Mid(t1, i, 1))
        If j = 0 Then
            ConvertText = ConvertText & "?"
        Else
            ConvertText = ConvertText & Mid(TrgList, j, 1)
        End If
    Next i
        
End Function

Change the SrcList and TrgList values to match what you want. You might want to include a space in there. Unmatched letters will be replaced with a ?. Then you'd use it on your worksheet like so:

Book1
	H	I
1	Cab	GPC
2	cab	fPC
3	xyz	Hkm
4	Cat act	GP??Pf?
Sheet13

Cell Formulas
Range	Formula
I1:I4	I1	=converttext(H1)

That's a slightly different take on it than mse330, so you have options.

 

[craigg3]

Thanks to both of you! I will play with both methods and see which one will fit my needs the best.

 

[craigg3]

Sure, open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to Insert a Module. Paste the following code in the window that opens:

Public Function ConvertText(t1 As String) As String
Dim i As Long, j As Long, SrcList As String, TrgList As String

    SrcList = "aAbBcCxXyYzZ"
    TrgList = "PtCefGHikLmn"
  
    For i = 1 To Len(t1)
        j = InStr(SrcList, Mid(t1, i, 1))
        If j = 0 Then
            ConvertText = ConvertText & "?"
        Else
            ConvertText = ConvertText & Mid(TrgList, j, 1)
        End If
    Next i
      
End Function

Change the SrcList and TrgList values to match what you want. You might want to include a space in there. Unmatched letters will be replaced with a ?. Then you'd use it on your worksheet like so:

Book1
	H	I
1	Cab	GPC
2	cab	fPC
3	xyz	Hkm
4	Cat act	GP??Pf?
Sheet13

Cell Formulas
Range	Formula
I1:I4	I1	=converttext(H1)

That's a slightly different take on it than mse330, so you have options.

Is there a way to call this function and apply it to the current cell value of each cell in range (B2:H10) instead of having to put =converttext in the cells? Thanks.

 

[Eric W]

Yes, you can call it in a loop:

Sub ConvertMany()

    For Each c In Range("B2:H10")
        c.Value = ConvertText(c.Value)
    Next c
End Sub

Add that code to the module. Change the range appropriately. Run it with the F5 button from the VBA editor, or call it with Alt-F8 from Excel. It replaces the current value of those cells, which can't be undone.

 

[craigg3]

Thanks Eric, works great!