Simple encryption function for Excel sheets

Question 1

I'm using this function to read a certain set of data in a hiddenSheet1 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 hiddenSheet1.)

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 RangeDim mtext As StringOn Error GoTo errHandlerSet mrange = Application.InputBox("Select cells to encrypt", , , , , , , 8)    If Not mrange.HasFormula Then        mrange.Value = Trim(mrange.Value)    End IferrHandler:    If err.Number = 424 Then        Exit Sub    End IfDim ss As RangeFor Each ss In mrangess.NumberFormat = "@"mtext = ss.textss = enc_Letter(mtext)Next ssEnd Sub

Question 2

Welcome to Code Review. What do you mean with 160k rows? Calling this method 160k times?

Question 3

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/…

Question 4

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)?

Question 5

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. Seethis question for a discussion on the topic.

Question 6

@HackSlashThat's not encryption. is incorrect. Seeen.wikipedia.org/wiki/Substitution_cipher . It is just a weak encryption. Nevertheless you are correct about the rest of your statement.

Question 7

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 andictionary-object by filling this dictionary-object once like so (keep in mind that my vba/vb knowledge is very rusty)

'declare at class/module levelDim dict As New Scripting.DictionaryPrivate Sub FillSubstitutionDictioanry()    For j = 1 To 52        dict.Add Sheet1.Cells(j, 1), Sheet1.Cells(j, 2)    Next jEnd 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 placeOption Explicit at the top of each module/class you use.
SeeWhat are the pros to using “option explict”

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

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

My mistake had also been that adding to a dict likedict.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 ExplicitDim dict As New Scripting.DictionaryDim dictionaryIsFilled As BooleanPrivate 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 SubPublic 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 yourLetEnc sub. The dictionary is only initialized once.

Make sure to have a reference toMicrosoft Scripting Runtime.

Question 8

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.

Question 9

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).

Question 10

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.

Question 11

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?

Question 12

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.

Heslacher 51k5 gold badges83 silver badges177 bronze badges · Accepted Answer · 2021-08-27 11:48:37Z

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 andictionary-object by filling this dictionary-object once like so (keep in mind that my vba/vb knowledge is very rusty)

'declare at class/module levelDim dict As New Scripting.DictionaryPrivate Sub FillSubstitutionDictioanry()    For j = 1 To 52        dict.Add Sheet1.Cells(j, 1), Sheet1.Cells(j, 2)    Next jEnd 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 placeOption Explicit at the top of each module/class you use.
SeeWhat are the pros to using “option explict”

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

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

My mistake had also been that adding to a dict likedict.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 ExplicitDim dict As New Scripting.DictionaryDim dictionaryIsFilled As BooleanPrivate 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 SubPublic 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 yourLetEnc sub. The dictionary is only initialized once.

Make sure to have a reference toMicrosoft 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.
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).
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.
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?
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.

Movatterモバイル変換

Stack Exchange Network

Simple encryption function for Excel sheets

1 Answer1

You mustlog in to answer this question.

Related

Hot Network Questions

Subscribe to RSS