Simple encryption function for Excel sheets

Question

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

• Heslacher: Welcome to Code Review. What do you mean with 160k rows? Calling this method 160k times?
• Ulquiorra Schiffer: 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/…
• Heslacher: 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)?
• HackSlash: 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.
• Heslacher: @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.

Answer 1

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
 dict.Add Sheet1.Cells(j, 1), Sheet1.Cells(j, 2)
 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
 dict.Add Sheet1.Cells(j, 1).value, Sheet1.Cells(j, 2).value
 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.

• Ulquiorra Schiffer: 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.
• Ulquiorra Schiffer: 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).
• Heslacher: 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.
• Ulquiorra Schiffer: 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?
• Heslacher: 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.