jason,

First thing I would do is add "Option Explicit" at the top of the module
and declare all variables.
Changing all those variants to their proper type could make some difference.
"Mid" also returns a variant unless you ask for a string...Mid$

Jim Cone
San Francisco, USA


"jasonsweeney"

wrote in message
news:jasonsweeney.1xngmd_1130565909.3329@excelforu m-nospam.com
A hobby of mine is writing encryption algorithms in Excel VBA. I freely
admit that I am both an amateur cryptographer and VBA programmer.

For those of you that are better programmers than I, can you come up
with a more effecient (read: quicker) way of implementing the
transposition cipher I provide below? (Hat tip to Norman Jones on the
scramble array used below).

To use, create the following:
(1) Userform1
(2) Textbox1 ' this box is used for informational purpose only. It
shows the array used to transpose the plaintext.
(3) Textbox2 ' type your plaintext message into this box
(4) Textbox3 ' Ciphertext is shown in this box
(5) Textbox4 ' Decrypted ciphertext is shown in this box
(6) CommandButton1 ' closes the userform
(7) CommandButton2 ' launches the code

Here is the code (paste into userform1):
_________________________________
Option Base 1
Private Sub CommandButton1_Click()
UserForm1.Hide

End Sub

Private Sub CommandButton2_Click()
Dim arr As Variant, arr2 As Variant
Dim array_count, String_array As String
Dim i As Long, j As Long
Dim swap As String
Dim strOut As String
Dim myarray() As Variant

If Len(UserForm1.TextBox2.Value) = 0 Then
MsgBox ("Enter text.")
Exit Sub
End If

Total_chars = Len(UserForm1.TextBox2.Value)
ReDim myarray(Total_chars)
modulus = 830584
base = 32
'
' Create scramble array with key
'
For q = 1 To Total_chars
tri_graph = "Zen" ' the Key
sub1 = Mid(tri_graph, 1, 1)
sub2 = Mid(tri_graph, 2, 1)
sub3 = Mid(tri_graph, 3, 1)
sub1_tri_graph = (Asc(sub1) + q - base) * alphabet_length ^ 2
sub2_tri_graph = (Asc(sub2) + q - base) * alphabet_length
sub3_tri_graph = (Asc(sub3) + q - base)
tri_sum = sub1_tri_graph + sub2_tri_graph + sub3_tri_graph
V = tri_sum
Mod_form = (V * 737333) - modulus * Int((V * 737333) / modulus)
myarray(q) = Mod_form ' the "raw" scrambled array
Next
'
'
' Sort Scramble
arr = myarray()
arr2 = arr
For i = LBound(arr) To UBound(arr)
For j = i + 1 To UBound(arr)
If arr(i) arr(j) Then
swap = arr(i)
arr(i) = arr(j)
arr(j) = CLng(swap)
End If
Next j
Next i
'
Dim NewArray() As Variant
ReDim NewArray(UBound(arr))
For i = LBound(arr) To UBound(arr)
NewArray(i) = strOut & Application.Match(arr2(i), arr, 0) ' changes
"raw" array into a ranked order array
strOut2 = strOut2 & NewArray(i) & ", "
Next i
TextBox1.Value = strOut2 ' just shows the ranked array, should be 1 to
number of characters in a srambled order
'
'
' ENCRYPT
Char_count = Len(TextBox2.Value)
For n = 1 To Char_count
current_pos = NewArray(n)
New_text = Mid(UserForm1.TextBox2.Value, current_pos, 1)
UserForm1.TextBox3.Value = UserForm1.TextBox3.Value & New_text
Next
'
'
' Decrypt
cipher_count = Len(TextBox3.Value)
order = 0
test_count = 0
For m = 1 To cipher_count
test_count = test_count + 1
For check = 1 To cipher_count
order = order + 1
If NewArray(order) - test_count = 0 Then
UserForm1.TextBox4.Value = UserForm1.TextBox4.Value &
Mid(UserForm1.TextBox3.Value, order, 1)
Exit For
End If

Next
order = 0
Next
'UserForm1.TextBox4.Value = Mid(UserForm1.TextBox3.Value,
NewArray(order + 4), 1)
End Sub
__________________________
-snip-
--
jasonsweeney