Speed up encryption code

jongooligan

Board Regular
Joined
Jul 23, 2007
Messages
90
Can anyone give me some tips to speed up this code? It applies a simple Ceasar Cipher to records in Excel - shifts text a number of places in the character set. So, if intDigitShift is 3 A would become D.
I'm using Excel 2003 on Windows XP SP2.

Application.ScreenUpdating = False
ActiveWorkbook.Worksheets("EncryptDecrypt").Activate
strFirst = Range("A1").Address
strLast = Range("A1").SpecialCells(xlCellTypeLastCell).Address

Set RgScramble = Range(strFirst, strLast)

For Each c In RgScramble
i = 1
strScrambled = "'"

strToScramble = c.Value
Do Until i = Len(strToScramble) + 1

lCode = Asc(Mid(strToScramble, i, 1)) + intDigitShift + i

strScrambled = strScrambled & Chr(lCode)

i = i + 1

Loop
c.Value = strScrambled

Next c

Range("A1").Select
Application.ScreenUpdating = True

MsgBox "Finished Encryption."
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
That will take a long time as you have to loop thru each cell and each character within each cell. Sorry, not much help I know...

Anyway, in case you are interested, here's a function that uses a slightly more advanced encryption routine (it's a Xor algorithm) you can use the following code I created:

Code:
Function XorC(ByVal sData As String, ByVal sKey As String) As String
    Dim l As Long, i As Long, byIn() As Byte, byOut() As Byte, byKey() As Byte
    Dim bEncOrDec As Boolean
    'confirm valid string and key input:
    If Len(sData) = 0 Or Len(sKey) = 0 Then XorC = "Invalid argument(s) used": Exit Function
    'check whether running encryption or decryption (flagged by presence of "xxx" at start of sData):
    If Left$(sData, 3) = "xxx" Then
        bEncOrDec = False   'decryption
        sData = Mid$(sData, 4)
    Else
        bEncOrDec = True   'encryption
    End If
    'assign strings to byte arrays (unicode)
    byIn = sData
    byOut = sData
    byKey = sKey
    l = LBound(byKey)
    For i = LBound(byIn) To UBound(byIn) - 1 Step 2
        byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - bEncOrDec 'avoid Chr$(0) by using bEncOrDec flag
        l = l + 2
        If l > UBound(byKey) Then l = LBound(byKey)  'ensure stay within bounds of Key
    Next i
    XorC = byOut
    If bEncOrDec Then XorC = "xxx" & XorC  'add "xxx" onto encrypted text
End Function

Use in a cell (or from within code) like:

=XorC(A1,"YourKey")

It's fairly secure (not to prolonged attacks, but definitely against casual observers), and it's fun!
 
Upvote 0
Steve 059L, switching off calculation saved me 17 seconds, 2:37 over 2:54 for 46,000 records. Only took 1:34 at 7 o'clock this morning when nobody else was on the network. To reverse the encryption simply replace the plus symbols with minus symbols - works a treat.

Richard - thanks for that. Was looking at writing an XOR function but this was easier. It only needs to be a weak encryption to deter users from browsing records they have no business to see.
 
Upvote 0
Richard,


Do you have the code necessary to reverse this function ?
Thanks for your function, Richard :)

Did you try out?
It is the same code for both operations.
Code:
  A         B          C         
1 abc       xxx!      abc       
2 123       xxxq]K     123       
3 Your text xxx"U Your text 
Prod
[Table-It] version 09 by Erik Van Geit
Code:
RANGE FORMULA (1st cell)
B1:C3 =XorC(A1,"AnyString")
[Table-It] version 09 by Erik Van Geit

kind regards,
Erik
 
Upvote 0

Forum statistics

Threads
1,221,310
Messages
6,159,173
Members
451,543
Latest member
cesymcox

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top