1
\$\begingroup\$

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
\$\endgroup\$
7
  • 1
    \$\begingroup\$ Welcome to Code Review. What do you mean with 160k rows? Calling this method 160k times? \$\endgroup\$
    – Heslacher
    Aug 26, 2021 at 11:50
  • \$\begingroup\$ 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/… \$\endgroup\$ Aug 26, 2021 at 11:52
  • 1
    \$\begingroup\$ 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)? \$\endgroup\$
    – Heslacher
    Aug 26, 2021 at 12:21
  • 3
    \$\begingroup\$ 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. \$\endgroup\$
    – HackSlash
    Aug 26, 2021 at 18:01
  • 1
    \$\begingroup\$ @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. \$\endgroup\$
    – Heslacher
    Aug 27, 2021 at 6:59

1 Answer 1

3
\$\begingroup\$

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.

\$\endgroup\$
8
  • \$\begingroup\$ 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. \$\endgroup\$ Aug 26, 2021 at 21:25
  • \$\begingroup\$ 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). \$\endgroup\$ Aug 26, 2021 at 21:28
  • \$\begingroup\$ 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. \$\endgroup\$
    – Heslacher
    Aug 27, 2021 at 6:55
  • \$\begingroup\$ 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? \$\endgroup\$ Aug 27, 2021 at 8:53
  • \$\begingroup\$ 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. \$\endgroup\$
    – Heslacher
    Aug 27, 2021 at 9:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.