Converting numbers to special symbols and converting the symbols back to numbers using vba

[kelly mort]

I am trying to assign symbols to digits as below:

0 = !
1 = @
2 = #
3 = <
4 = ~
5 = :
6 = $
7 = %
8 = ?
9 = &

So that When I have a number like "2031", I want to convert it to:

#! <@

And in the case of ?~$$ I want to convert it to 8466

How do I do that?

Thanks in advance.
Kelly

 

[Joe4]

Here are two User Defined Functions that will do each one:

Function NumToChar(str As String) As String
'   Convert from numbers to characters

    Dim arr As Variant
    Dim i As Long
    Dim temp As String
    
    arr = Array("!", "@", "#", "<", "~", ":", "$", "%", "?", "&")
    
    If Len(str) > 0 Then
        For i = 1 To Len(str)
            temp = temp & arr(Mid(str, i, 1))
        Next i
    
    End If
    
    NumToChar = temp
    
End Function


Function CharToNum(str As String) As String
'   Convert from characters to numbers

    Dim arr As Variant
    Dim i As Long
    Dim j As Long
    Dim temp As String
    Dim z As String
    
    arr = Array("!", "@", "#", "<", "~", ":", "$", "%", "?", "&")
    
    If Len(str) > 0 Then
        For i = 1 To Len(str)
            z = Mid(str, i, 1)
            For j = LBound(arr) To UBound(arr)
                If z = arr(j) Then
                    temp = temp & j
                    Exit For
                End If
            Next j
        Next i
    
    End If
    
    CharToNum = temp
    
End Function

Then you would use them like any other function, either in VBA, or directly on the worksheet like an Excel function.

Here is a quick test to verify your results:

Sub Test()

    Dim x As String
    Dim y As String
    
    x = "2031"
    y = "?~$$"
    
    MsgBox NumToChar(x)
    MsgBox CharToNum(y)
    
End Sub

 

[ranman256]

make a table with your settings (above)
then use a lookup/swap out.

 

[Joe4]

make a table with your settings (above)
then use a lookup/swap out.

That would work fine if your string were only exactly one character long, but how would you do that when you need to iterate through each character of the string?
You would still need VBA or some complex formula.

 

[kelly mort]

Thanks @Joe4

It worked great.

Have a wonderful weekend.

@ranman256,

Thanks for your suggestion, I will have a look at that too.

 

[Joe4]

You are welcome.
Glad I could help.

 

[Marc L]

Another way with an unique function using MATCH worksheet function (needing to replace some special characters) :​

Function SCrypto(ByVal V)
    Dim W(), S&, C$, X
        W = [{"!","@","#","<","£",":","$","%","|","&"}]
    For S = 1 To Len(V)
           C = Mid$(V, S, 1)
        If C Like "[0-9]" Then
            SCrypto = SCrypto & W(C + 1)
        Else
            X = Application.Match(C, W, 0)
            If IsNumeric(X) Then SCrypto = SCrypto & X - 1 Else SCrypto = SCrypto & C
        End If
    Next
End Function

Sub Demo1()
    MsgBox SCrypto(2031)
End Sub

Sub Demo2()
    MsgBox SCrypto("|£$$")
End Sub

 

[kelly mort]

Another way with an unique function using MATCH worksheet function (needing to replace some special characters) :​

Function SCrypto(ByVal V)
    Dim W(), S&, C$, X
        W = [{"!","@","#","<","£",":","$","%","|","&"}]
    For S = 1 To Len(V)
           C = Mid$(V, S, 1)
        If C Like "[0-9]" Then
            SCrypto = SCrypto & W(C + 1)
        Else
            X = Application.Match(C, W, 0)
            If IsNumeric(X) Then SCrypto = SCrypto & X - 1 Else SCrypto = SCrypto & C
        End If
    Next
End Function

Sub Demo1()
    MsgBox SCrypto(2031)
End Sub

Sub Demo2()
    MsgBox SCrypto("|£$$")
End Sub

Your approach is cool.

 

[Rick Rothstein]

Everybody's code seems so long to me...

Function Num2Sym(S As String) As String
  Dim X As Long
  Num2Sym = S
  For X = 1 To Len(S)
    Mid(Num2Sym, X) = Mid("!@#<~:$%?&", Mid(S, X, 1) + 1, 1)
  Next
End Function

Function Sym2Num(S As String) As String
  Dim X As Long
  Sym2Num = S
  For X = 1 To Len(S)
    Mid(Sym2Num, X) = InStr("!@#<~:$%?&", Mid(S, X, 1)) - 1
  Next
End Function

 

[Marc L]

Hi Rick,​

​

why not an unique function rather than two ? …​