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

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.