Códificación Vigenere

Les pido disculpas si no es del todo apropiado pero la verdad fue hecho a pelo en unos 20 minutos para superar un reto así que es posible que aún tenga sus detalles si alguien quiere usarlo y cambiar las funciones puede hacerlo, si creen que alguno de los cambios hechos por ustedes puede mejorar el código, con gusto agradeceré sus comentarios.

' Este programa fue hecho con la intención de usar la codificación Vigenere que fue el
' primer método de cifrado  polialfabetico
' Y fue hecho usando la tabla original, en realidad se podría usar una variante de esta o
' incluir más carácteres de los que actualmente tiene, pero eso ya es otra historia.

'================================= Variables ============================================
Dim Tabla(26, 26) As String, Mensaje As String, Pass As String, i1 As Integer, Resulta As String
Dim Aux As String, Car As Integer, MSpa As String, MPas As String, EspaM As Integer
Dim UbicaEspM() As Integer , EspaP As Integer, UbicaEspP() As Integer, CarS() As String
Dim  CarP() As String, Partes As Integer, Residuo As Integer
Dim cadena As String, x As Integer, Y As Integer, I2 As Integer
' No pienso que haga falta comentar cada una de ellas

Private Sub btCodificar_Click()
MSpa = ""
MPas = ""
cadena = ""
Resulta = ""
LimpiaMensaje txMen.Text, txPass.Text
If MSpa <> "" And cadena <> "" Then
  For i1 = 1 To Len(cadena)
    Aux = Mid(MSpa, i1, 1)
    Car = Asc(Aux)
    x = Car - 64
    Aux = Mid(cadena, i1, 1)
    Car = Asc(Aux)
    Y = Car - 64
    Resulta = Resulta & Tabla(x, Y)
  Next
End If
AgregaRuido Resulta
txRes = Resulta
End Sub

Private Sub btDecodificar_Click()
MSpa = ""
MPas = ""
cadena = ""
Resulta = ""
LimpiaMensaje txMen.Text, txPass.Text
If MSpa <> "" And cadena <> "" Then
  For i1 = 1 To Len(cadena)
    Aux = Mid(cadena, i1, 1)
    Car = Asc(Aux)
    x = Car - 64
    Aux = Mid(MSpa, i1, 1)
    For I2 = 1 To 26
      If Aux = Tabla(x, I2) Then
        Y = I2
        Exit For
      End If
    Next
    Resulta = Resulta & Tabla(1, Y)
  Next
End If
AgregaRuido Resulta
txRes = Resulta
End Sub


Private Sub Form_Load()
Dim x As Integer, Y As Integer
x = 1
For i1 = 65 To 90
 Tabla(1, x) = Chr(i1)
 x = x + 1
Next
x = 1
For I2 = 2 To 26
  For i1 = 1 To 26
    If x >= 26 Then
      x = 1
      Tabla(I2, i1) = Tabla(I2 - 1, x)
    Else
      Tabla(I2, i1) = Tabla(I2 - 1, x + 1)
      x = x + 1
    End If
  Next
Next
End Sub


Function LimpiaMensaje(TextO As String, PassO As String)
If Trim(TextO) <> "" And Trim(PassO) <> "" Then 
' verifico que haya algo para codificar y una contraseña
  Mensaje = UCase(TextO)                         ' Bueno la idea de convertir el mensaje a mayúsculas, viene del
  Pass = UCase(PassO)                           ' hecho de la limitación de carácteres de la tabla original

  For i1 = 1 To Len(Mensaje)                     ' Esto es para reubicar los caracteres no incluidos
    Aux = Mid(Mensaje, i1, 1)
    Car = Asc(Aux)
    If Car < 65 Or Car > 90 Then                 ' Es decir si no son letras de la A - Z (consultar tabla Ascii :XD)
      EspaM = EspaM + 1
    End If
  Next
  ReDim UbicaEspM(EspaM)
  ReDim CarS(EspaM)
  MSpa = ""
  EspaM = 1
  ' Aquí esta el verdadero poder de la funcion porque obtiene el mensaje limpio y la ubicación de los carácteres especiales
  For i1 = 1 To Len(Mensaje)
    Aux = Mid(Mensaje, i1, 1)
    Car = Asc(Aux)
    If Car < 65 Or Car > 90 Then
      UbicaEspM(EspaM) = i1
      CarS(EspaM) = Aux
      EspaM = EspaM + 1
    Else
      MSpa = MSpa & Aux
    End If
  Next
  ' Ahora lo mismo para la contraseña
  For i1 = 1 To Len(Pass)
    Aux = Mid(Pass, i1, 1)
    Car = Asc(Aux)
    If Car < 65 Or Car > 90 Then
      EspaP = EspaP + 1
    End If
  Next
  ReDim UbicaEspP(EspaP)
  ReDim CarP(EspaP)
  MPas = ""
  EspaP = 1
  For i1 = 1 To Len(Pass)
    Aux = Mid(Pass, i1, 1)
    Car = Asc(Aux)
    If Car < 65 Or Car > 90 Then
      UbicaEspP(EspaP) = i1
      CarS(EspaM) = Aux
      EspaP = EspaP + 1
    Else
      MPas = MPas & Aux
    End If
  Next
  If Len(MPas) > Len(MSpa) Then
    MsgBox "La contraseña no puede ser más larga que el mensaje", vbCritical + vbOKOnly, "Error"
    Exit Function
  Else
    If Len(MSpa) Mod Len(MPas) = 0 Then       ' Esto es para hacer que la contraseña sea igual de larga que el mensaje
      Partes = Len(MSpa) / Len(MPas)
      For i1 = 1 To Partes
        cadena = cadena & MPas
      Next
    Else
      Residuo = Len(MSpa) Mod Len(MPas)
      Partes = ((Len(MSpa) - Residuo) / Len(MPas))
      For i1 = 1 To Partes
        cadena = cadena & MPas
      Next
      cadena = cadena & Left(MPas, Residuo)
    End If
  End If
End If
End Function

Function AgregaRuido(Aque As String)
Dim D As Integer
Aux = ""
I2 = 1
Pass = ""
Car = UbicaEspM(I2) - 1
If Aque <> "" Then
  Aux = Left(Aque, Car) & CarS(I2)
  Pass = Pass & Aux
  Aque = Right(Aque, Len(Aque) - Car)
  For i1 = 2 To EspaM - 1
    D = i1 - 1
    Car = UbicaEspM(i1) - UbicaEspM(D) - 1
    Aux = Left(Aque, Car) & CarS(i1)
    Pass = Pass & Aux
    Aque = Right(Aque, Len(Aque) - Car)
  Next
  Pass = Pass & Aque
  If Len(txMen) = Len(Pass) Then
    Resulta = Pass
  End If
End If

End Function