Visual Basic for Applications/Simple Vigenere Cipher in VBA

SummaryEdit

  • This VBA code module runs the Vigenere cipher for user strings. It is used to conceal the contents of a message. The sender and recipient share a secret word or phrase, the so-called key, used to scramble (encrypt) and unscramble (decrypt) the message. The code does not include spaces, since these tend to assist in code breaking. It could have been further restricted to just capital letters, but it was decided to include integers to make it a bit more useful.
  • The code is intended for Microsoft Excel, but is easily adapted to work in other MS Office products that run VBA.
  • Figure 1 shows the Vigenere table without integers or other characters. Figure 2, the basis for the coding, shows a similar table that includes integers and capitals, and no other characters. These codes have been in use since the sixteenth century.
  • The Vigenere cipher makes use of a repeated keyword or phrase. That is to say, the key string is repeated as often as necessary to cover the message, prior to working. This can be seen in the example of Figure 1, where the keyword "BULGE" was extended to "BULGEBUL" to cover the eight characters of the message.
  • The coded version of the cipher uses a calculation to simulate the tabular method. The twenty-six letters of the alphabet and the ten integers are assigned number values between zero and thirty-five. Then, for encryption, key values are modulo-36 added to message values to make the ciphertext. For decryption, key values are subtracted from the ciphertext, again using modulo-36 arithmetic, and always producing positive values. Numbers are converted back to characters for display.

Notes on the CodeEdit

 
Figure 1: The Vigenere cipher uses the intersection of table entries for encryption and a reverse lookup for decryption. Notice in this example that the two instances of the letter E were encrypted differently. The extended table that is the basis of the coding however, can be found in Figure 2.
  • No userform is provided. Instead, type message and key strings, and the boolean value for the working mode, into the top procedure directly. Interested parties might well add a user form of their own.
  • CheckInputs() makes sure that no illegal characters are included, while procedure LongKey() makes a key value equal in length to the message.
  • CharaToMod36() converts each string character, of both message and key, to its set-position number. Another procedure, Mod36ToChara() converts these numbers back again prior to display.
  • AddMod36() performs modulo-36 addition, and subtracts 36 from numbers larger than 35 to keep the result within the set. The procedure SubMod36() performs subtraction, and adds 36 to any negative results, again, to keep the numbers within range.
  • There is some latitude for improvement of the code. For example, the set could be further extended, and the key could be tested to avoid some of the flaws that are characteristic of this cipher. At present, the user must interpret the position for spaces in the decrypted results; this helps to better conceal the use of the frequently used space character. So, extend the set only at the risk of worsened performance. As mentioned before, a user form could be made to replace direct entry.
  • Because repeat patterns can develop, some care is needed in coding. Clearly, a key that consists only of one repeated character would not be very secure, especially if it were the letter A. (Try it!). A good mixture of characters makes for the best key, and if the key completely covers the message without repetition, so much the better. This latter situation helps to avoid patterns that might make for easier cracking. In fact, if instead of a repeated key, a hash of the key were used, many of these pattern weaknesses might be avoided. Those who have an interest in such modifications will find hash procedures elsewhere in this series; (use base64 output). That said, care should be taken to include only alpha characters and integers from any such hash, or errors will result. (B64 strings from hash algorithms typically have three additional symbol characters to avoid, =, +, and /. )

A Larger Vigenere TableEdit

Figure 2: Vigenere Cipher Table with Capitals and Integers


If all else fails, and for those who prefer manual working anyway, the table in the above drop-box may be found useful. It lists both capitals and integers. Notice that although both tables have a passing similarity, their content is quite different in places, so they are not fully interchangeable.

A Worked ExampleEdit

The following panel shows how the calculation works for the coded version. It is analogous to the adding and subtraction of character distances within a closed set. Other implementations of the manual method have included the sliding of one set of characters against another for the required distances, sometimes using concentric discs. Figure 2 can be interpreted as a listing of every possible combination of messages and keys.

        THE CHARACTER SET AND ITS VALUES
         A    B    C    D    E    F    G    H    I    J    K    L    M
         0    1    2    3    4    5    6    7    8    9   10   11   12 
         
         N    O    P    Q    R    S    T    U    V    W    X    Y    Z
        13   14   15   16   17   18   19   20   21   22   23   24   25 

         0    1    2    3    4    5    6    7    8    9
        26   27   28   29   30   31   32   33   34   35
        
        
        ENCRYPTION WORKING
         S    E    N    D    H    E    L    P      message               (1)
         B    U    L    G    E                     key             
         B    U    L    G    E    B    U    L      extended key          (2)
        18    4   13    3    7    4   11   15      message values        (3) 
         1   20   11    6    4    1   20   11      key values            (4)
        19   24   24    9   11    5   31   26      (3)+(4)               (5)
         T    Y    Y    J    L    F    5    0      cipher text (Note 1)  (7)

        Note 1:   Subtract 36 from any numbers here that might exceed 35.
        
        Notice that each instance of "E" results in different cipher text.
        
        DECRYPTION WORKING
         T    Y    Y    J    L    F    5    0      cipher text           (8)
         B    U    L    G    E                     key             
         B    U    L    G    E    B    U    L      extended key          (9)
        19   24   24    9   11    5   31   26      cipher text values   (10)         
         1   20   11    6    4    1   20   11      key values           (11)
        18    4   13    3    7    4   11   15      (10) minus (11)      (12)   
         S    E    N    D    H    E    L    P      plain text (Note 2)  (15) 

        Note 2:   Add 36 to any numbers here that might become negative.
        

The VBA Code ModuleEdit

Copy this entire code listing into an Excel standard module, save the file as a xlsm type, then run the top procedure. No user form code has been provided, so the user should enter his message (sTxt) and key (sKey) strings directly into the section identified in the top procedure. Be sure to identify whether encryption or decryption is intended with the setting of the variable bEncrypt.

Corrections:
6 April 2020; corrected a note in SubMod36(); does not affect operation.

Option Explicit

Sub EncryptDecrypt()
    'Run this procedure for a simple Vigenere encryption/decryption
    'Capital letters and integers only; no symbols; no spaces.(ie: mod36 working).
    'Set message, key and mode directly in this procedure before running it.
    'Output to a message box and Excel. Overwrites some cells in Sheet1.
    
    Dim vA() As String, oSht As Worksheet
    Dim nM As Long, c As Long
    Dim sTxt As String, sK As String
    Dim sKey As String, sMode As String, sAccum As String
    Dim bEncrypt As Boolean, bMOK As Boolean, bKOK As Boolean
    
    Set oSht = ThisWorkbook.Worksheets("Sheet1")
    
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    '-------------------------USER ADDS DATA HERE------------------------
    'user should enter texts and encrypt/decrypt choice here
    sTxt = "2019forthecup"  'text to process, plain or cipher
    sKey = "BOGEYMAN"       'Key word or phrase
    bEncrypt = True         'set True for encrypt; False for decrypt
    '---------------------------------------------------------------------
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    
    'convert both strings to upper case
    sTxt = UCase(sTxt)
    sKey = UCase(sKey)
    
    'check the message and key for illegal characters
    'restricted here to capital letters and integers only
    bMOK = CheckInputs(sTxt)
    bKOK = CheckInputs(sKey)
    If bMOK = False Or bKOK = False Then
        If sTxt <> "" And sKey <> "" Then
            MsgBox "Illegal characters found."
        Else
            MsgBox "Empty strings found."
        End If
        Exit Sub
    End If
    
    'make an extended key to match the message length
    nM = Len(sTxt)
    sKey = LongKey(sKey, nM)
        
    'dimension a work array equal in length to the message
    ReDim vA(1 To 10, 1 To nM) '10 rows and nM columns
    
    'read the message, key, and mod-36 values into array
    For c = LBound(vA, 2) To UBound(vA, 2) 'r,c
        'text chara by chara
        vA(1, c) = CStr(Mid$(sTxt, c, 1)) 'message charas
        vA(2, c) = CStr(Mid$(sKey, c, 1)) 'key charas
        'text's converted number values
        vA(3, c) = CStr(CharaToMod36(Mid$(sTxt, c, 1))) 'number values of charas
        vA(4, c) = CStr(CharaToMod36(Mid$(sKey, c, 1))) 'number values of charas
    Next c
       
    'steer code for encrypt or decrypt
    If bEncrypt = True Then 'encrypt
        sMode = " : Encryption result" 'display string
        GoTo ENCRYPT
    Else
        sMode = " : Decryption result" 'display string
        GoTo DECRYPT
    End If

ENCRYPT:
    'sum of converted key and message values mod-26
    'then find string character values of sums
    For c = LBound(vA, 2) To UBound(vA, 2)
        vA(5, c) = CStr(AddMod36(CLng(vA(3, c)), CLng(vA(4, c))))
        vA(6, c) = Mod36ToChara(CLng(vA(5, c)))
    Next c
    
    'accumulate the encrypted charas into a single display string
    'for message box and worksheet
    For c = LBound(vA, 2) To UBound(vA, 2)
        sAccum = sAccum & vA(6, c) 'mixed
    Next c
    GoTo DISPLAY

DECRYPT:
    'subtract key values from encrypted chara values
    'and make negative values positive by adding 26
    'Find string character values of the differences
    For c = LBound(vA, 2) To UBound(vA, 2)
        vA(5, c) = CStr(SubMod36(CLng(vA(3, c)), CLng(vA(4, c))))
        vA(6, c) = Mod36ToChara(CLng(vA(5, c)))
    Next c
    
    'accumulate the encrypted charas into a display string
    'for message box and worksheet
    For c = LBound(vA, 2) To UBound(vA, 2)
        sAccum = sAccum & vA(6, c) 'mixed
    Next c
    GoTo DISPLAY

DISPLAY:
    'message box display
    MsgBox sTxt & " : Text to Process" & vbCrLf & _
           sKey & " : Extended Key" & vbCrLf & _
           sAccum & sMode
    'and output to sheet1 in monospaced font
    With oSht
        .Cells(1, 1).Value = sTxt
        .Cells(1, 2).Value = " : Text to Process"
        .Cells(2, 1).Value = sKey
        .Cells(2, 2).Value = " : Extended Key"
        .Cells(3, 1).Value = sAccum
        .Cells(3, 2).Value = sMode
        .Cells.Font.Name = "Consolas"
        .Columns("A:A").Select
    End With
    
    'make columns fit text length
    Selection.Columns.AutoFit
    oSht.Cells(1, 1).Select

End Sub

Function CheckInputs(sText As String) As Boolean
    'checks message and key for illegal characters
    'here intends use of capitals A-Z, ie ASCII 65-90
    'and integers 0-9, ie ASCII 48-57
    
    Dim nL As Long, n As Long
    Dim sSamp As String, nChr As Long
    
    'check for empty strings
    If sText = "" Then
        MsgBox "Empty parameter string - closing"
        Exit Function
    End If
    
    'test each character
    nL = Len(sText)
    For n = 1 To nL
        'get characters one by one
        sSamp = Mid$(sText, n, 1)
        'convert to ascii value
        nChr = Asc(sSamp)
        'filter
        Select Case nChr
            Case 65 To 90, 48 To 57
                'these are ok
            Case Else
                MsgBox "Illegal character" & vbCrLf & _
                "Only capital letters and integers are allowed; no symbols and no spaces"
                Exit Function
        End Select
    Next n
     
    CheckInputs = True

End Function
        
Function LongKey(sKey As String, nLM As Long) As String
    'makes a repeated key to match length of message
    'starting from the user's key string
    'used in both encryption and decryption
    
    Dim nLK As Long, n As Long, m As Long
    Dim p As Long, sAccum As String
    
    'make long key
    nLK = Len(sKey)
    'if key is longer than message
    If nLK >= nLM Then
        LongKey = Left$(sKey, nLM) 'trim key to fit
        Exit Function
    Else 'message is assumed longer than key
        n = Int(nLM / nLK) 'number of repeats needed
        m = nLM - (n * nLK) 'number of additional characters
        For p = 1 To n
            sAccum = sAccum & sKey
        Next p
        sAccum = sAccum & Left$(sKey, m) 'add any end characters
    End If
    
    LongKey = sAccum

End Function

Function CharaToMod36(sC As String) As Long
    'gets the modulo-36 value of the input character
    'as it exists in the working set
    'For example range A to Z becomes 0 to 25
    'and 0 to 9 become 26 to 35
    
    Dim nASC As Long
    
    'get ascii value of character
    nASC = Asc(sC)
    
    'align charas to working set
    Select Case nASC
    Case 65 To 90
        'subtract 65 to convert to zero based set
        CharaToMod36 = nASC - 65
    Case 48 To 57
        'subtract 22 to convert to zero based set
        CharaToMod36 = nASC - 22
    End Select

End Function

Function Mod36ToChara(nR As Long) As String
    'gets the character for a mod-36 value
    'For example range 0 to 25 becomes A to Z
    'and 26 to 35 become 0 to 9
       
    Select Case nR
    Case 0 To 25 'cap letters, A-Z
        Mod36ToChara = Chr(nR + 65)
    Case 26 To 35 'integers, 0-9
        Mod36ToChara = Chr(nR + 22)
    Case Else
        MsgBox "Illegal character in Mod36ToChara"
        Exit Function
    End Select

End Function

Function AddMod36(nT As Long, nB As Long) As Long
    'adds two positive integers to mod-36, ie set 0-35,
    'that is, no output can exceed 35
            
    Dim nSum As Long
    
    If nT >= 0 And nT < 36 And nB >= 0 And nB < 36 Then
        'inputs are all ok
    Else
        MsgBox "Parameters out of bounds in AddMod36"
    End If
        
    nSum = nT + nB
    
    AddMod36 = nSum Mod 36

End Function

Function SubMod36(nT As Long, nB As Long) As Long
    'subtracts nB from nT mod-36
    'that is, no output can be negative or exceed 35
    'Returns negative results as positive by adding 36
    
    Dim nDif As Long
    
    If nT >= 0 And nT < 36 And nB >= 0 And nB < 36 Then
        'inputs are all ok
    Else
        MsgBox "Parameters out of bounds in SubMod36"
    End If
    
    nDif = nT - nB 'possibly negative
    
    If nDif < 0 Then
        nDif = nDif + 36
    End If
        
    SubMod36 = nDif

End Function

Sub Notes()
    'Notes on the code
    
    'A to Z, correspond to character set positions 0 to 25.
    '0 to 9, correspond to character set positions 26 to 35.
    'The modulus for addition and subtraction is therefore 36.
    'Negative results in caculation are made positive by adding 36.
    'Positive results in calculation greater than 35 are reduced by 36.
    
    'ASCI values made calculation simple here but a more general version could
    'preload any character set for lookup with alternative coding.
        
    'See Wikibooks text for a table image and further details.

End Sub

See AlsoEdit