Implementing a simple substitution cipher using 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.