For no particular reason, I wanted to create a function that would take a string and "encrypt" it via Caesar cipher. This function takes a string and shifts the letters left or right (in the alphabet) depending on the input. Shift right(2) for instance would be -
ABCDEFGHIJKLMNOPQRSTUVWXYZ
CDEFGHIJKLMNOPQRSTUVWXYZAB
The UDF:
Option Explicit
Public Function CaesarCipher(ByVal TextToEncrypt As String, ByVal CaesarShift As Long) As String
'Positive means shift to right e.g. "A" Shift 1 returns "B"
Dim IsPositive As Boolean
IsPositive = True
If CaesarShift < 0 Then IsPositive = False
CaesarShift = Abs(CaesarShift)
Dim OutputText As String
TextToEncrypt = UCase(TextToEncrypt)
If CaesarShift > 26 Then
CaesarShift = CaesarShift Mod 26
End If
If IsPositive Then
OutputText = ShiftRight(TextToEncrypt, CaesarShift)
Else: OutputText = ShiftLeft(TextToEncrypt, CaesarShift)
End If
CaesarCipher = OutputText
End Function
The shifting functions:
Private Function ShiftRight(ByVal ShiftString As String, ByVal ShiftQuantity As Long) As String
Dim TextLength As Long
TextLength = Len(ShiftString)
Dim CipherText As String
Dim CharacterCode As Long
Dim AsciiIndex As Long
Dim AsciiIdentifier() As Long
ReDim AsciiIdentifier(1 To TextLength)
For AsciiIndex = 1 To TextLength
CharacterCode = Asc(Mid(ShiftString, AsciiIndex, 1))
If CharacterCode + ShiftQuantity > 90 Then
CharacterCode = CharacterCode - 26 + ShiftQuantity
ElseIf CharacterCode = 32 Then GoTo Spaces
Else: CharacterCode = CharacterCode + ShiftQuantity
End If
Spaces:
AsciiIdentifier(AsciiIndex) = CharacterCode
Next
For AsciiIndex = 1 To TextLength
CipherText = CipherText & Chr(AsciiIdentifier(AsciiIndex))
Next
ShiftRight = CipherText
End Function
Private Function ShiftLeft(ByVal ShiftString As String, ByVal ShiftQuantity As Long) As String
Dim TextLength As Long
TextLength = Len(ShiftString)
Dim CipherText As String
Dim CharacterCode As Long
Dim AsciiIndex As Long
Dim AsciiIdentifier() As Long
ReDim AsciiIdentifier(1 To TextLength)
For AsciiIndex = 1 To TextLength
CharacterCode = Asc(Mid(ShiftString, AsciiIndex, 1))
If CharacterCode = 32 Then GoTo Spaces
If CharacterCode - ShiftQuantity < 65 Then
CharacterCode = CharacterCode + 26 - ShiftQuantity
Else: CharacterCode = CharacterCode - ShiftQuantity
End If
Spaces:
AsciiIdentifier(AsciiIndex) = CharacterCode
Next
For AsciiIndex = 1 To TextLength
CipherText = CipherText & Chr(AsciiIdentifier(AsciiIndex))
Next
ShiftLeft = CipherText
End Function