Implementing a simple substitution cipher using VBA - vba

Question

I am trying to make a program that changes letters in a string and i keep running into the obvious issue of if it changes a value, say it changes A to M, when it gets to M it will then change that M to something else, so when i run the code to change it all back it converts it as if the letter was originally an M not an A.
Any ideas how to make it so the code doesnt change letters its already changed?
as for code ive just got about 40 lines of this (im sure theres a cleaner way to do it but im new to vba and when i tried select case it would only change one letter and not go through all of them)
Text1.value = Replace(Text1.value, "M", "E")

Answer 1

Try this:
Dim strToChange As String
strToChange = "This is my string that will be changed"
Dim arrReplacements As Variant
arrReplacements = Array(Array("a", "m"), _
Array("m", "z"), _
Array("s", "r"), _
Array("r", "q"), _
Array("t", "a"))
Dim strOutput As String
strOutput = ""
Dim i As Integer
Dim strCurrentLetter As String
For i = 1 To Len(strToChange)
strCurrentLetter = Mid(strToChange, i, 1)
Dim arrReplacement As Variant
For Each arrReplacement In arrReplacements
If (strCurrentLetter = arrReplacement(0)) Then
strCurrentLetter = Replace(strCurrentLetter, arrReplacement(0), arrReplacement(1))
Exit For
End If
Next
strOutput = strOutput & strCurrentLetter
Next
Here is the output:
Thir ir zy raqing ahma will be chmnged

Answer 2

Loop through it using the MID function. Something like:
MyVal = text1.value
For X = 1 to Len(MyVal)
MyVal = Replace(Mid(MyVal, X, 1), "M", "E")
X = X + 1
Next X
EDIT: OK upon further light, I'm gonna make one change. Store the pairs in a table. Then you can use DLookup to do the translation, using the same concept:
MyVal = text1.value
For X = 1 to Len(MyVal)
NewVal = DLookup("tblConvert", "fldNewVal", "fldOldVal = '" & Mid(MyVal, X, 1) & "")
MyVal = Replace(Mid(MyVal, X, 1), Mid(MyVal, X, 1), NewVal)
X = X + 1
Next X

Answer 3

Here's another way that uses less loops
Public Function Obfuscate(sInput As String) As String
Dim vaBefore As Variant
Dim vaAfter As Variant
Dim i As Long
Dim sReturn As String
sReturn = sInput
vaBefore = Split("a,m,s,r,t", ",")
vaAfter = Split("m,z,r,q,a", ",")
For i = LBound(vaBefore) To UBound(vaBefore)
sReturn = Replace$(sReturn, vaBefore(i), "&" & Asc(vaAfter(i)))
Next i
For i = LBound(vaAfter) To UBound(vaAfter)
sReturn = Replace$(sReturn, "&" & Asc(vaAfter(i)), vaAfter(i))
Next i
Obfuscate = sReturn
End Function
It turns every letter into an ampersand + the replacement letters ascii code. Then it turns every ascii code in the replacement letter.
It took about 5 milliseconds vs 20 milliseconds for the nested loops.