Place Secret Messages in Excel

Ever want to send a secret message to your friend?  Want it to be secure and encrypted and not immediately obvious to anyone who looks at it?  Well how about using Excel and VBA to create a workbook with a hidden message!

Simply Create a new VBA module and paste the following code in it.

 Public Function encrypt(sText As String) As String  
   Dim i As Long  
   Dim Order() As Variant  
   Dim myLetter As Integer  
   Dim newString As String  
   sText = LCase(sText)  
   Order = Array(97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, _  
          110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122)  
   For i = 1 To Len(sText)  
     myLetter = Asc(Mid(sText, i, 1)) - 96  
     If myLetter < 0 Or myLetter > 26 Then  
       newString = newString & Chr(myLetter + 96)  
     Else  
       newString = newString & Chr(Order(myLetter - 1))  
       algorithm Order, myLetter  
     End If  
   Next  
   encrypt = newString  
 End Function  
 Function decrypt(sText As String) As String  
   Dim i As Long  
   Dim NormOrder() As Variant  
   Dim Order() As Variant  
   Dim myLetter As Integer  
   Dim newString As String  
   sText = LCase(sText)  
   NormOrder = Array(97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, _  
          110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122)  
   Order = Array(97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, _  
          110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122)  
   For i = 1 To Len(sText)  
     myLetter = Asc(Mid(sText, i, 1)) - 96  
     If myLetter < 0 Or myLetter > 26 Then  
       newString = newString & Chr(myLetter + 96)  
       GoTo nexti  
     End If  
     If i = 1 Then  
       myLetter = Asc(Mid(sText, i, 1)) - 96  
       newString = Mid(sText, i, 1)  
       algorithm Order, myLetter  
     Else  
       myLetter = Asc(Mid(sText, i, 1))  
       myLetter = getPlace(myLetter, Order)  
       newString = newString & Chr(NormOrder(myLetter))  
   'Debug.Assert Chr(NormOrder(myLetter)) <> "i"  
       'cycle the order again  
       myLetter = NormOrder(myLetter) - 96  
       algorithm Order, myLetter  
     End If  
 nexti:  
   Next  
   decrypt = newString  
 End Function  
 Function getPlace(chrNum As Integer, Order() As Variant) As Integer  
   Dim i As Integer  
   For i = LBound(Order) To UBound(Order)  
     If Order(i) = chrNum Then  
       getPlace = i  
       Exit Function  
     End If  
   Next i  
 End Function  
 Function algorithm(Order() As Variant, letterNum As Integer)  
   Dim i  
   Dim j As Double  
   Dim newOrder() As Variant  
   Dim temp  
   Dim offset As Double  
   ReDim newOrder(LBound(Order) To UBound(Order))  
   letterNum = letterNum - 1  
   'initial switch  
   temp = Order(UBound(Order))  
   Order(UBound(Order)) = Order(letterNum)  
   Order(letterNum) = temp  
   offset = Round(Exp(letterNum) / 2)  
 reTest:  
   If offset > UBound(Order) Then  
     offset = offset - (UBound(Order) * Application.WorksheetFunction.RoundDown(offset / (UBound(Order)), 0))  
     GoTo reTest  
   End If  
   'shift entire array  
   For i = LBound(Order) To UBound(Order)  
     j = i + offset  
     If j > 25 Then j = j - 26  
     newOrder(UBound(Order) - i) = Order(j)  
   Next i  
   'replace the order variable  
   For i = LBound(newOrder) To UBound(newOrder)  
     Order(i) = newOrder(i)  
   Next i  
 End Function  

The idea is simple. Instead of storing text in the workbook, this will store the ASCII character codes in the form of font sizes in your workbook!

In addition to this simple method of hiding a message in a workbook, this code also encrypts the ascii character codes by offsetting the characters.


To dig deeper:


Give each letter a number. For example:

A = 1, B = 2, C = 3,...,Z = 26


get it?


Let's say your message is "Hi":


Your first letter would be H, so the number 8.

well now, we don't want to simply store the letter i as number 9, instead, we will offset the entire alphabet by the letter H--AKA the number 8.


so now, the letter i becomes 9 + 8 = 17


so the encoded message would be the numbers 8, 17.


The result are two cells in the Excel Sheet with font sizes 8 and 17.


Have fun with it!