Scramble and Unscramble a message

natygrosso

New Member
Joined
Mar 11, 2010
Messages
3
Hi,

I have an excel file like this with all the alphabet letters:

<table style="border-collapse: collapse; width: 173pt;" border="0" cellpadding="0" cellspacing="0" width="230"><col style="width: 85pt;" width="113"> <col style="width: 88pt;" width="117"> <tbody><tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt; width: 85pt;" height="17" width="113">Original character</td> <td style="width: 88pt;" width="117">Changed character</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">a</td> <td class="xl63">e</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">b</td> <td class="xl63">v</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">c</td> <td class="xl63">d</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">d</td> <td class="xl63">I</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">e</td> <td class="xl63">z</td> </tr> </tbody></table>
I need two write two subs, Scramble and Unscramble. In each, ask the user for a message in an input box. In the Scramble sub, this will be an original message; in the Unscramble sub, it will be a scramble message. Then in the Scramble sub, scramble the message and display it. In the unscramble sub, unscramble the message and display it.

I would appreciate any help or can anyone point me in the right direction.

Thank you :)
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Hi Naty. You will need to have some sort of "key" to reference. That is, some sort of standard to to convert your message between scrambled to unscrambled...
 
Upvote 0
Hi Tom,

Thanks for the reply. They gave me the key on an excel file a column with the alphabet and the next column just random letters. Is that what you mean?

Like this:

<table style="border-collapse: collapse; width: 173pt;" border="0" cellpadding="0" cellspacing="0" width="230"><col style="width: 85pt;" width="113"> <col style="width: 88pt;" width="117"> <tbody><tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt; width: 85pt;" height="17" width="113">Original character</td> <td style="width: 88pt;" width="117">Changed character</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">a</td> <td class="xl63">e</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">b</td> <td class="xl63">v</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">c</td> <td class="xl63">d</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">d</td> <td class="xl63">I</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">e</td> <td class="xl63">z</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">f</td> <td class="xl63">y</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">g</td> <td class="xl63">b</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">h</td> <td class="xl63">m</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">I</td> <td class="xl63">r</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl63" style="height: 12.75pt;" height="17">j</td> <td class="xl63">n</td> </tr> </tbody></table>
Thank you
 
Upvote 0
A simple approach would be to have two arrays, one holding the orignal characters, the other its coded equivalent.

Then loop through the input message one character at a time, find the character's position in the original array and take the corresponding character in the second array and build up a coded string.

To use paste into the ThisWorkbook module
Step through the Scramble Procedure (F8) and open the Locals Window, View => Locals Window, this will let you see the coded string being assembled.

Code:
[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]
 
[COLOR=darkblue]Sub[/COLOR] Scramble()
   [COLOR=darkblue]Dim[/COLOR] aOriginal()
   [COLOR=darkblue]Dim[/COLOR] aCoded()
   [COLOR=darkblue]Dim[/COLOR] msg [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] msgEncrypt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] msgDecode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
 
   aOriginal = Array("A", "B", "C", "D", "E")
   aCoded = Array("E", "V", "D", "I", "Z")
   msg = "DEAD" [COLOR=green]'InputBox("Please Enter a Word.")[/COLOR]
   msgEncrypt = Encrypt(msg, aOriginal, aCoded)
   Debug.Print msgEncrypt
 
   msgDecode = Decode(msgEncrypt, aOriginal, aCoded)
   Debug.Print msgDecode
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[COLOR=darkblue][/COLOR] 
[COLOR=darkblue][/COLOR] 
[COLOR=darkblue]Function[/COLOR] Encrypt(msg [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
                  a1 [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], _
                  a2 [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]) [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] lenMsg [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] counter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] myChr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] myCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
 
   lenMsg = Len(msg)
 
   [COLOR=darkblue]Do[/COLOR]
      counter = counter + 1
      myChr = Mid(msg, counter, 1)
      [COLOR=darkblue]For[/COLOR] i = 0 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](a1)
         [COLOR=darkblue]If[/COLOR] a1(i) = myChr [COLOR=darkblue]Then[/COLOR]
            myCode = myCode & a2(i)
            [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
      [COLOR=darkblue]Next[/COLOR] i
   [COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]While[/COLOR] counter < lenMsg
   Encrypt = myCode
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]
[COLOR=darkblue][/COLOR] 
[COLOR=darkblue][/COLOR] 
[COLOR=darkblue]Function[/COLOR] Decode(msg [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
               a1 [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], _
               a2 [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]) [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] lenMsg [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] counter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] myChr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] myCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
 
   lenMsg = Len(msg)
 
   [COLOR=darkblue]Do[/COLOR]
      counter = counter + 1
      myChr = Mid(msg, counter, 1)
      [COLOR=darkblue]For[/COLOR] i = 0 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](a2)
         [COLOR=darkblue]If[/COLOR] a2(i) = myChr [COLOR=darkblue]Then[/COLOR]
            myCode = myCode & a1(i)
            [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
      [COLOR=darkblue]Next[/COLOR] i
   [COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]While[/COLOR] counter < lenMsg
   Decode = myCode
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]
 
Upvote 0
natygrosso,

Working with your original 5 characters.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Adding the Macro
1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code:
Option Explicit
Sub Test()
' hiker95, 03/11/2010
Dim MyReply As String, MyMsg As String
MyReply = InputBox("Enter 'S' to Scramble, 'U' to Un-Scramble.")
If MyReply = "S" Or MyReply = "s" Then
  MyMsg = InputBox("Enter your text string to Scramble.")
  MsgBox "Entered text:  " & MyMsg & vbCrLf & vbCrLf & _
         "  Scrambled:  " & Scramble(MyMsg, 0)

ElseIf MyReply = "U" Or MyReply = "u" Then
  MyMsg = InputBox("Enter your text string to Un-Scramble.")
  MsgBox "Scrambled text:  " & MyMsg & vbCrLf & vbCrLf & _
         " un-scrambled:  " & Scramble(MyMsg, 1)
End If
End Sub


Public Function Scramble(InString, SU As Integer) As String
' hiker95, 03/11/2010
'
' =Scramble(A1,0)
' 0 for Scramble, 1 for Un-Scramble
'
Dim SL As Long, SC As String, SUsw As Integer, FS As String, a As Long
SL = Len(InString)
SUsw = SU
If SUsw = 0 Then
  For a = 1 To SL
    SC = Mid(InString, a, 1)
    Select Case SC
      Case " "
        FS = " "
      Case "a"
        FS = "e"
      Case "b"
        FS = "v"
      Case "c"
        FS = "d"
      Case "d"
        FS = "l"
      Case "e"
        FS = "z"
      Case Else
        FS = "?"
    End Select
    Scramble = Scramble & FS
  Next a
ElseIf SUsw = 1 Then
  For a = 1 To SL
    SC = Mid(InString, a, 1)
    Select Case SC
      Case " "
        FS = " "
      Case "e"
        FS = "a"
      Case "v"
        FS = "b"
      Case "d"
        FS = "c"
      Case "l"
        FS = "d"
      Case "z"
        FS = "e"
      Case Else
        FS = "?"
    End Select
    Scramble = Scramble & FS
  Next a
End If
End Function


Then run the "Test" macro.
 
Upvote 0
I want to apologize to everyone that got affected by my mistake. I didn't mean any harm or wasting anyones time. It was plain ignorance on the forum subject. I assure that the lesson was learned and it would never happen again.Thank you very much for everyones help it is greatly appreciate it.
Thank you
Naty
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,122
Members
448,550
Latest member
CAT RG

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top