# Simple encryption function for Excel sheets

I'm using this function to read a certain set of data in a hidden Sheet1 to do encryption based on the selection by the user. It's all working fine, but its kinda slow, I need to apply this to 160.000 rows.

ATM it goes through every letter of every word of every selected range.

(Function below is used to encrypt letters, based on the "data set" in the hidden Sheet1.)

Public Function enc_Letter(mtext As String)

Dim mChr As String
Dim mResult As String

For i = 1 To Len(mtext)

mChr = Mid(mtext, i, 1)

For j = 1 To 53

If j = 53 Then
mResult = "Encryption_Error"
GoTo err
End If

If mChr = Sheet1.Cells(j, 1) Then

mResult = mResult & Sheet1.Cells(j, 2)

Exit For
End If

Next j

Next i
err:
enc_Letter = mResult

End Function


Edit: I have added the Sub mabye this helps in finding a solution:

Sub LetEnc()

Dim mrange As Range
Dim mtext As String
On Error GoTo errHandler
Set mrange = Application.InputBox("Select cells to encrypt", , , , , , , 8)
If Not mrange.HasFormula Then
mrange.Value = Trim(mrange.Value)
End If
errHandler:
If err.Number = 424 Then
Exit Sub
End If
Dim ss As Range

For Each ss In mrange
ss.NumberFormat = "@"
mtext = ss.text
ss = enc_Letter(mtext)
Next ss

End Sub

• Welcome to Code Review. What do you mean with 160k rows? Calling this method 160k times? Aug 26, 2021 at 11:50
• 160.000 records in excel. So Im using this code to encrypt a large amount of records (rows) in Excel. Sometimes I also select a large selection to use it. google.nl/… Aug 26, 2021 at 11:52
• Is this encryption just substituting a character by a different character? Are the values for 1<j<53 in Sheet1.Cells(j, 1) all unique and as well in Sheet1.Cells(j, 2)? Aug 26, 2021 at 12:21
• That's not encryption. Rule #1 of encryption is to never attempt to invent your own algorithm unless you are in to high level maths. You can leverage known encryption libraries. See this question for a discussion on the topic. Aug 26, 2021 at 18:01
• @HackSlash That's not encryption. is incorrect. See en.wikipedia.org/wiki/Substitution_cipher . It is just a weak encryption. Nevertheless you are correct about the rest of your statement. Aug 27, 2021 at 6:59

If I assume correctly you have in Sheet1 something like below:

Column 1 | Column 2
a        | x
b        | c
c        | k


then you can take advantage of an dictionary-object by filling this dictionary-object once like so (keep in mind that my vba/vb knowledge is very rusty)

'declare at class/module level
Dim dict As New Scripting.Dictionary

Private Sub FillSubstitutionDictioanry()
For j = 1 To 52
Next j
End Sub


which can be used in your function like so

Public Function enc_Letter(mtext As String) as String

Dim mChr As String
Dim mResult As String

For i = 1 To Len(mtext)

mChr = Mid(mtext, i, 1)
if dict.Exists(mChr) then
mResult = mResult & dict.Item(mChar)
Else
enc_Letter = "Encryption_Error"
Exit Function
End If
Next i
enc_Letter = mResult

End Function


Edit

Like I said, my vba is very rusty.

First, you should always place Option Explicit at the top of each module/class you use.
See What are the pros to using “option explict”

Yes, it will prevent some types of mistakes. One of the most obvious ones is if you make a typo and spell the variable name incorrectly, it will flag that the mistyped variable doesn't exist.

It then would have been obvious that in the line mResult = mResult & dict.Item(mChar) the variable mChar would be unkown.

My mistake had also been that adding to a dict like dict.Add Sheet1.Cells(j, 1), Sheet1.Cells(j, 2) would not add the value of these cells but the cells itself.

So I have cleaned this up, like so

Option Explicit
Dim dict As New Scripting.Dictionary
Dim dictionaryIsFilled As Boolean

Private Sub FillSubstitutionDictioanry()
If dictionaryIsFilled Then Exit Sub

Dim j  As Integer
For j = 1 To 52
Next j

dictionaryIsFilled = True

End Sub
Public Function enc_Letter(mtext As String) As String

FillSubstitutionDictioanry

Dim mChr As String
Dim i As Integer

For i = 1 To Len(mtext)

mChr = Mid(mtext, i, 1)
If dict.Exists(mChr) Then
enc_Letter = enc_Letter & dict(mChr)
Else
enc_Letter = "Encryption_Error"
Exit Function
End If

Next i

End Function


which can be called just from your LetEnc sub. The dictionary is only initialized once.

Make sure to have a reference to Microsoft Scripting Runtime.

• I have put the first part into a module and the second code I replaced with my own it doesn't replace te letters anymore with the second new code. Aug 26, 2021 at 21:25
• With the dictionary-object I basically build what I have in Sheet1 in code right? Using the dictionary-object is that what you mean? Because I did not do that (yet). Aug 26, 2021 at 21:28
• The dictionary object contains the values of the first column for rows 1..52 as dictionary-keys and the values of the second column for rows 1..52 as dictionary-valus. I have edited the answer to show where the mistakes had been. This is tested at least for my workbook. Aug 27, 2021 at 6:55
• thanks I do have one question more so as you already suspected Sheet1 looks like you assumed, but I do have a column 3 and 4 with the numbers inside from 1 to 10. I'm trying to use your code with the number encryption but I keep getting this error: This key is already associated with an element of this collection (Error 457). I suspect because sheet1 is already used? How can I solve this to use the same collection but with column 3 and 4? Aug 27, 2021 at 8:53
• Just use a second dictionary. I assume you do a loop from 1..10 having as keys 0,1,2,3...9 and the values distributed different. Aug 27, 2021 at 9:06