Perform character substitution using Excel VBA - vba

Question

Say you would like to set up a very simple Caesar Cipher, where A --> 1, B --> 2 ... etc.
Say you have a word "Hello" in a cell that you would like to encrypt. You can set up a very simple For Loop to loop through each word:
For i = 1 To Len("Hello")
'perform encryption here
Next i
Is there a quick an easy way to map values from a pre-defined range? I.e. we know that A = 1, or 1 + 26, or 1 + 2*(26) .. etc...
Rather than writing IF statement to check for all letters, I wonder if there is an elegant way of doing this to get: "8 5 12 12 15"

Answer 1

Get the cell's output as a string with Byte array:
Dim brr() As Byte, i As Long, k As String
brr() = StrConv(Cells(1, 3), vbFromUnicode)
Then assess each letter in the new array against a larger array:
dim arr as variant
arr = array("a", "b")
For i = 0 To UBound(brr) 'need to start at 0, lbound applies for std array, not byte
'match brr value to arr value, output arr location
'k will store the final string
k = k + 'didn't look up the output for application.match(arr())
Next i
Edit1: Thanks to JohnColeman, i can add Asc() to the above and it shouldn't need the additional array for A, B, C, etc.
Dim brr() As Byte, i As Long, k As String
brr() = StrConv(Cells(1, 3), vbFromUnicode)
for i = 0 To UBound(brr)
k = k & " " & Asc(brr(i)) 'something like that
next i

Answer 2

Using the Dictionary route, you can build a dictionary which is a list of key, value pairs to hold your cypher. In your case the key of a would have the value 1 and the key of b would have the value 2, and so on. Then you can just bump your word, letter by letter, against the dictionary to build your cipher:
Function caesarCipher(word As String) As String
'create an array of letters in their position for the cipher (a is 1st, b is 2nd)
Dim arrCipher As Variant
arrCipher = Split("a b c d e f g h i j k l m n o p q r s t u v x y z", " ")
'Create a dictionary from the array with the key being the letter and the item being index + 1
Dim dictCipher As Scripting.Dictionary
Set dictCipher = New Dictionary
For i = 0 To UBound(arrCipher)
dictCipher.Add arrCipher(i), i + 1
Next
'Now loop through the word letter by letter
For i = 1 To Len(word)
'and build the cipher output
caesarCipher = caesarCipher & IIf(Len(caesarCipher) = 0, "", " ") & dictCipher(LCase(Mid(word, i, 1)))
Next
End Function
This is a nice way of doing it because you can change your cipher to be whatever you want and you only need monkey with your dictionary. Here I just build a dictionary from an array and use the array's index for the cipher output.

Answer 3

This might get you started:
Function StringToNums(s As String) As Variant
'assumes that s is in the alphabet A, B, ..., Z
Dim nums As Variant
Dim i As Long, n As Long
n = Len(s)
ReDim nums(1 To n)
For i = 1 To n
nums(i) = Asc(Mid(s, i, 1)) - Asc("A") + 1
Next i
StringToNums = nums
End Function
Sub test()
Debug.Print Join(StringToNums("HELLO"), "-") 'prints 8-5-12-12-15
End Sub

Answer 4

All of the answers are good, but this is how you use a dictionary which is simpler and more straight-forward. I defined the dictionary implicitly to make it easier to start, but it is better to define it explicitly by adding runtime scripting from the tools>references in VBE.
Sub Main()
Dim i As Integer
Dim ciphered As String, str As String
Dim dict As Object
Set dict = CreateObject("scripting.Dictionary")
str = "Hello"
For i = 65 To 122
dict.Add Chr(i), i - 64
Next i
For i = 1 To Len(str)
ciphered = ciphered & "-" & dict(Mid(UCase(str), i, 1))
Next i
ciphered = Right(ciphered, Len(ciphered) - 1)
Debug.Print ciphered
End Sub
if you remove ucase when getting the code from the dictionary it will count for the case meaning that uppercase or lowercase will have different codes. You can change this to a function easily, don't forget to remove str = "Hello". Right now it returns:
Output
8-5-12-12-15