Ok, I’ve been dancing around dictionaries in VBA for weeks—mainly because they seemed confusing. And I’m lazy. Turns out, they are supremely helpful storage devices. If say, you want a randomly ordered alphabet (otherwise known as a deranged alphabet) for a simple substitution cipher, the easiest way to store each letter with it’s new associated value is with a dictionary.
How to Script a Dictionary
‘This creates a dictionary
Dim dictionaryname as Object
Set dictionaryname = CreateObject(“Scripting.Dictionary”)
‘This assigns a value to to a key
dictionaryname.Add Key:=”Key Name“, Item:=”The Item“
‘This gets a value with the key
dictionaryname(“Key Name“)
But before actually filling the dictionary with the alphabet, you’ll have to randomize the order. Unfortunately, I haven’t seen a way to shuffle a dictionary in VBA, but you can get somewhat creative with the Rnd (Random) and Mid function.
First, you set up a string to work with:
alphabet = “abcdefghijklmnopqrstuvwxyz“
Then set up a loop to run for the length of the string, decreasing by one for each letter of the alphabet that’s getting pushed into the dictionary. You’ll also need a variable to represent the number of letters left in the alphabet.
alphacount = 26
For i = 0 To Len(alphabet) – 1
Now we generate a random number between however many characters are left in the alphabet and one. I want to have a column with my randomized alphabet next to the regular one. Before starting up my VBA, I put the alphabet into Column A. Setting Cells(i+1, 2) to the character in the randomValue position will push those values into Column B.
randomValue = Int((alphacount) * Rnd()) + 1
Cells(i+1, 2).Value = Mid(alphabet, randomValue,1)
With those two columns set, populating the dictionary is a quick matter of:
dictionaryName.Add Key:=Cells(i + 1, 1).Value, Item:=Cells(i + 1, 2).Value
Last, you’ll need to set everything up for the next loop. Take down alphabetcount by one to generate a smaller random number and slice the letter at the randomized position out of the alphabet string.
alphacount = alphacount – 1
‘In VBA, you can use & to concatenate two strings
alphabet = Left(alphabet, randomValue – 1) & Right(alphabet, Len(alphabet) – randomValue)
That alone will get you a deranged alphabet. But if you actually want to translate a message into that alphabet, you’ll need to run one last block of code. This takes the string in Column E, Row 2 and runs each character through a loop, appending the new value to a variable called NewText. The last line puts NewText into Column E, Row 5.
CipherText = Cells(2, 5).Value
For n = 0 To Len(CipherText) – 1
Letter = Mid(CipherText, n + 1, 1)
NewText = NewText + dict(Letter)
Next
Cells(8, 5).Value = NewText
If all has gone according to plan, you should be able to put in a giant block of text and derange it in a single click. No spaces or punctuation (because that would make it too easy to read).
Here’s a screenshot of how I set up my spreadsheet beforehand:
Keep in mind, VBA populates columns B, C and Cell E8. You provide everything else.
The Code
One preliminary disclaimer. This script does not work with mixed case strings. In the plain text, you’ll need to keep it all lowercase.
Sub DerangedAlphabet() Dim CipherText As String Dim NewText As String Dim dict As Object Dim alphabet As String Dim randomValue As Integer Set dict = CreateObject("Scripting.Dictionary") NewText = "" alphabet = "abcdefghijklmnopqrstuvwxyz" alphacount = 26 For i = 0 To Len(alphabet) - 1 randomValue = Int((alphacount) * Rnd()) + 1 'Cells(i + 1, 1).Value = randomValue Cells(i + 1, 2).Value = Mid(alphabet, randomValue, 1) dict.Add Key:=Cells(i + 1, 1).Value, Item:=Cells(i + 1, 2).Value alphacount = alphacount - 1 alphabet = Left(alphabet, randomValue - 1) & Right(alphabet, Len(alphabet) - randomValue) Cells(i + 1, 3).Value = alphabet Next CipherText = Cells(2, 5).Value For n = 0 To Len(CipherText) - 1 Letter = Mid(CipherText, n + 1, 1) NewText = NewText + dict(Letter) Next Cells(8, 5).Value = NewText End Sub
nice keep up the vba – excel tutos
LikeLiked by 1 person
Thanks ARJ 🙂 Many more coming soon!
LikeLike