Hello,

I have made a password cracker for Excel, which gives the password to
unprotect a sheet. It works up to a 12 position password by trying all the
options. The problem is that it take too much time.

Does anybody know how to speed up this macro ?

Greetings,
Aalt
================================================== =====
Option Explicit
Public win_a As String
Public win_b As String
Public passo As String
Public Const A_MAX As Integer = 110
Public Const B_MAX As Integer = 36

Sub SH_openen()
'=Dimensioning
Dim tel_01 As Integer
Dim tel_02 As Integer
Dim tel_03 As Integer
Dim tel_04 As Integer
Dim tel_05 As Integer
Dim tel_06 As Integer
Dim tel_07 As Integer
Dim tel_08 As Integer
Dim tel_09 As Integer
Dim tel_10 As Integer
Dim tel_11 As Integer
Dim tel_12 As Integer
Dim ZZ(1 To 110) As String
Dim file_name As String
Dim sheet_name As String
'= Configuration
win_a = ActiveWorkbook.Name
Worksheets("SH_Open").Range("C7").ClearContents
file_name = Worksheets("SH_Open").Range("C5").Value
sheet_name = Worksheets("SH_Open").Range("C6").Value
Worksheets("SH_Open").Range("C9").Value = Now()
ZZ(1) = "a"
ZZ(2) = "b"
ZZ(3) = "c"
ZZ(4) = "d"
ZZ(5) = "e"
ZZ(6) = "f"
ZZ(7) = "g"
ZZ(8) = "h"
ZZ(9) = "i"
ZZ(10) = "j"
ZZ(11) = "k"
ZZ(12) = "l"
ZZ(13) = "m"
ZZ(14) = "n"
ZZ(15) = "o"
ZZ(16) = "p"
ZZ(17) = "q"
ZZ(18) = "r"
ZZ(19) = "s"
ZZ(20) = "t"
ZZ(21) = "u"
ZZ(22) = "v"
ZZ(23) = "w"
ZZ(24) = "x"
ZZ(25) = "y"
ZZ(26) = "z"
ZZ(27) = "A"
ZZ(28) = "B"
ZZ(29) = "C"
ZZ(30) = "D"
ZZ(31) = "E"
ZZ(32) = "F"
ZZ(33) = "G"
ZZ(34) = "H"
ZZ(35) = "I"
ZZ(36) = "J"
ZZ(37) = "K"
ZZ(38) = "L"
ZZ(39) = "M"
ZZ(40) = "N"
ZZ(41) = "O"
ZZ(42) = "P"
ZZ(43) = "Q"
ZZ(44) = "R"
ZZ(45) = "S"
ZZ(46) = "T"
ZZ(47) = "U"
ZZ(48) = "V"
ZZ(49) = "W"
ZZ(50) = "X"
ZZ(51) = "Y"
ZZ(52) = "Z"
ZZ(53) = "0"
ZZ(54) = "1"
ZZ(55) = "2"
ZZ(56) = "3"
ZZ(57) = "4"
ZZ(58) = "5"
ZZ(59) = "6"
ZZ(60) = "7"
ZZ(61) = "8"
ZZ(62) = "9"
ZZ(63) = "'"
ZZ(64) = "-"
ZZ(65) = "!"
ZZ(66) = """"
ZZ(67) = "#"
ZZ(68) = "$"
ZZ(69) = "%"
ZZ(70) = "&"
ZZ(71) = "("
ZZ(72) = ")"
ZZ(73) = "*"
ZZ(74) = ","
ZZ(75) = "."
ZZ(76) = ":"
ZZ(77) = ";"
ZZ(78) = "?"
ZZ(79) = "@"
ZZ(80) = "["
ZZ(81) = "\"
ZZ(82) = "]"
ZZ(83) = "^"
ZZ(84) = "_"
ZZ(85) = "`"
ZZ(86) = "{"
ZZ(87) = "|"
ZZ(88) = "}"
ZZ(89) = "~"
ZZ(90) = "¦"
ZZ(91) = "¨"
ZZ(92) = "´"
ZZ(93) = "¸"
ZZ(94) = "+"
ZZ(95) = "<"
ZZ(96) = "="
ZZ(97) = ""
ZZ(98) = "±"
ZZ(99) = "«"
ZZ(100) = "»"
ZZ(101) = "¢"
ZZ(102) = "£"
ZZ(103) = "§"
ZZ(104) = "µ"
ZZ(105) = "¼"
ZZ(106) = "½"
ZZ(107) = "¾"
ZZ(108) = "¹"
ZZ(109) = "²"
ZZ(110) = "³"
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
win_a = ActiveWorkbook.Name
Workbooks.Open Filename:=file_name
'Actie bij 1 positie
For tel_01 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_01
'Actie bij 2 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_02
Next tel_01
'Actie bij 3 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_03
Next tel_02
Next tel_01
'Actie bij 4 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 5 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04) & ZZ(tel_05)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 6 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03) &
ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 7 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) & ZZ(tel_03)
& ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 8 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) &
ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07) & ZZ(tel_08)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect
password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 9 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02) &
ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07) & ZZ(tel_08)
& ZZ(tel_09)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect
password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 10 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
For tel_10 = 1 To A_MAX
If Range("A1").Value = "Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) & ZZ(tel_02)
& ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07) &
ZZ(tel_08) & ZZ(tel_09) & ZZ(tel_10)
Application.StatusBar = passo
Sheets(sheet_name).Unprotect
password:=passo
Range("A1").Value = "Aalt"
End If
Next tel_10
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 11 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
For tel_10 = 1 To A_MAX
For tel_11 = 1 To A_MAX
If Range("A1").Value = "Aalt"
Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) &
ZZ(tel_02) & ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07)
& ZZ(tel_08) & ZZ(tel_09) & ZZ(tel_10) & ZZ(tel_11)
Sheets(sheet_name).Unprotect
password:=passo
Application.StatusBar =
passo
Range("A1").Value = "Aalt"
End If
Next tel_11
Next tel_10
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Actie bij 12 posities
For tel_01 = 1 To A_MAX
For tel_02 = 1 To A_MAX
For tel_03 = 1 To A_MAX
For tel_04 = 1 To A_MAX
For tel_05 = 1 To A_MAX
For tel_06 = 1 To A_MAX
For tel_07 = 1 To A_MAX
For tel_08 = 1 To A_MAX
For tel_09 = 1 To A_MAX
For tel_10 = 1 To A_MAX
For tel_11 = 1 To A_MAX
For tel_12 = 1 To A_MAX
If Range("A1").Value =
"Aalt" Then
Call endings
Exit Sub
Else
passo = ZZ(tel_01) &
ZZ(tel_02) & ZZ(tel_03) & ZZ(tel_04) & ZZ(tel_05) & ZZ(tel_06) & ZZ(tel_07)
& ZZ(tel_08) & ZZ(tel_09) & ZZ(tel_10) & ZZ(tel_11) & ZZ(tel_12)
Application.StatusBar =
passo

Sheets(sheet_name).Unprotect password:=passo
Range("A1").Value =
"Aalt"
End If
Next tel_12
Next tel_11
Next tel_10
Next tel_09
Next tel_08
Next tel_07
Next tel_06
Next tel_05
Next tel_04
Next tel_03
Next tel_02
Next tel_01
'Afronden
Application.Calculation = xlCalculationAutomatic
Calculate
Worksheets("SH_Open").Range("C10").Value = Now()
End Sub

Private Sub endings()
Application.Calculation = xlCalculationAutomatic
Calculate
win_b = ActiveWorkbook.Name
Workbooks(win_b).Close SaveChanges:=False
Windows(win_a).Activate
Worksheets("SH_Open").Range("C7").Value = passo
Worksheets("SH_Open").Range("C10").Value = Now()
End Sub