Convert Characters Based On Custom Map

Hi,
I'm looking for a macro to convert each character in a string into another character based on a custom map. I realize I could use VLOOKUP but then I'd need to somehow break out each character individually, return each value, then concatenate everything back together. It's not ideal. Any help would be much appreciated!

Thanks!

Can you give us more details?

Sure. Say if a cell contain the value "welcome". In the adjacent cell to the right I'd like the translated/encoded value "SXBO-MX". Each character would be converted based on the attached map.

w=S
e=X
l=B
c=O
o=-
m=M
e=X

m_map.xlsx

Thanks!

See if this works for you.
For what it is worth, if you mapped your character set to an ASCII order,
(see: http://www.asciitable.com/) for values 32 to 122,
then you would only need one Const string, instead of two.

Function MapOriginal2Code(sText As String) As String
    Const sOriginal = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-_1234567890"
    Const sCode = "R_ilPwEvFTJ1UtfbYQso39dVIujzOWXmZqraHBM2-eLCc87KS46NDGg5yxkAp0hn"
    Dim i As Long, nPos As Long, sResult As String
    
    For i = 1 To Len(sText)
        nPos = InStr(1, sOriginal, Mid$(sText, i, 1))
        If nPos Then
            sResult = sResult & Mid$(sCode, nPos, 1)
        Else
            sResult = sResult & Mid$(sText, i, 1)
        End If
    Next i
    MapOriginal2Code = sResult
End Function

Function MapCode2Original(sText As String) As String
    Const sOriginal = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-_1234567890"
    Const sCode = "R_ilPwEvFTJ1UtfbYQso39dVIujzOWXmZqraHBM2-eLCc87KS46NDGg5yxkAp0hn"
    Dim i As Long, nPos As Long, sResult As String
    
    For i = 1 To Len(sText)
        nPos = InStr(1, sCode, Mid$(sText, i, 1))
        If nPos Then
            sResult = sResult & Mid$(sOriginal, nPos, 1)
        Else
            sResult = sResult & Mid$(sText, i, 1)
        End If
    Next i
    MapCode2Original = sResult
End Function

Sub Run_Map()
    Dim sText As String
    sText = MapOriginal2Code("Convert Characters Based On Custom Map")
    MsgBox sText & " = " & MapCode2Original(sText)
End Sub

Thanks Steven, this works great! After assigning sText to reference A1 and returning sResult in B1, how can I repeat it until it reaches the end of the list or the first blank?

Function MapOriginal2Code(sText As String) As String
    Const sOriginal = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-_1234567890"
    Const sCode = "-P2KHd7ZG3s14WRVhqmaJe8rQUz_gpwuTtbXLkFEB56ylfAMc0YOCjvnNSDxIo9"
    Dim i As Long, nPos As Long, sResult As String
    
    sText = Range("A1")
    
    For i = 1 To Len(sText)
        nPos = InStr(1, sOriginal, Mid$(sText, i, 1))
        If nPos Then
            sResult = sResult & Mid$(sCode, nPos, 1)
        Else
            sResult = sResult & Mid$(sText, i, 1)
        End If
    Next i
    MapOriginal2Code = sResult
   
    Range("B1").Select
    ActiveCell.FormulaR1C1 = sResult
    
End Function

Thanks!

Version 2 works like a UDF and can be used in any column.

Function MapOriginal2Code_V2(rg As Range) As String
    Const sOriginal = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-_1234567890"
    Const sCode = "-P2KHd7ZG3s14WRVhqmaJe8rQUz_gpwuTtbXLkFEB56ylfAMc0YOCjvnNSDxIo9"
    Dim i As Long, nPos As Long, sResult As String, sText As String
    
    sText = rg.Value
    
    For i = 1 To Len(sText)
        nPos = InStr(1, sOriginal, Mid$(sText, i, 1))
        If nPos Then
            sResult = sResult & Mid$(sCode, nPos, 1)
        Else
            sResult = sResult & Mid$(sText, i, 1)
        End If
    Next i
    MapOriginal2Code_V2 = sResult
End Function

Version 3 takes text in column A and places the code in column B.

Sub MapOriginal2Code_V3()
    Const sOriginal = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-_1234567890"
    Const sCode = "-P2KHd7ZG3s14WRVhqmaJe8rQUz_gpwuTtbXLkFEB56ylfAMc0YOCjvnNSDxIo9"
    Dim i As Long, nPos As Long, sResult As String, j As Long, sText As String
    
    For j = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        sText = Cells(j, "A")
        sResult = ""
        For i = 1 To Len(sText)
            nPos = InStr(1, sOriginal, Mid$(sText, i, 1))
            If nPos Then
                sResult = sResult & Mid$(sCode, nPos, 1)
            Else
                sResult = sResult & Mid$(sText, i, 1)
            End If
        Next i
        Cells(j, "B") = sResult
    Next j
End Sub

Both are great, thanks again Steven!