Crack Excel Workbook/Worksheet Protection

Press Alt F11 to open the VBA editor and copy paste the code

Select the worksheet in Project Explorer press F7 and Copy Paste the below code in code window.

Press run on the ribbion or press F5.

You can call this Macro from some other macro if u dont want to go to VBA and run it.

Create a button on the sheet and on click event call the macro ExcelProtectionCracker.

-----------------------------------------------------------------------------------------------
Public Sub ExcelProtectionCracker()
' Breaks worksheet and workbook structure Protection. Bob McCormick
' probably originator of base code algorithm modified to Crack
' Excel Workbook Structure/Windows and Sheet prptections.
'
' Arpit Sharda 20-Feb-2010 (Version 1.1)
' Reveals Hashed passwords NOT original passwords

Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"Adapted from Bob McCormick base code by " & _
"Arpit Sharda"
Const HEADER As String = "Excel Protection Cracker"
Const VERSION As String = DBLSPACE & "Version 1.1.1 2010-Feb-20"
Const FEEDBACK As String = DBLSPACE & "Please feedback or report any failure " & _
"to http://discovarp.blogspot.com/"

Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
"now be free of all password protection, so make sure you:" & _
DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
DBLSPACE & "Also, remember that the password was " & _
"put there for a reason. Don't stuff up crucial formulas " & _
"or data." & DBLSPACE & "Access and use of some data " & _
"may be an offense. If in doubt, don't."

Const NOPROTECTIONMSG As String = "Workbook Structure/Window Protection and Worksheet Protection is not Enabled. " & _
"No Password Found." & AUTHORS & VERSION

Const NOBOOKPROTECTION As String = "Workbook Structure/Window Protection is not Enabled " & DBLSPACE & _
"Proceeding to unprotect sheets." & AUTHORS & VERSION

Const TIMEALERT As String = "This may take some time " & _
"to calculate the Hashed Password." & DBLSPACE & "Press OK to Continue. " & AUTHORS & VERSION

Const BOOKPROTECTIONFOUND As String = "You had a WorkBook " & _
"Structure/Windows Protection Enabled." & DBLSPACE & _
"The Hashed password found was: " & DBLSPACE & "$$" & DBLSPACE & _
"Now continuing to check and clear other Protection." & AUTHORS & VERSION

Const SHEETPROTECTIONFOUND As String = "You had a Worksheet " & _
"password set." & DBLSPACE & "The Hashed password found was: " & _
DBLSPACE & "$$" & DBLSPACE & DBLSPACE & "Now continuing to check and clear " & _
"other passwords." & AUTHORS & VERSION

Const ONLYBOOKPROTECTION As String = "Only Workbook Structure/Window Protection was Enabled " & _
"Hashed Password Matched and Workbook Structure/Window was just Unlocked." & _
ALLCLEAR & AUTHORS & VERSION & FEEDBACK


Dim ws1 As Worksheet, ws2 As Worksheet

' Variables used to create Hashed Password values using nested for loops
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer

' Hashed Password found
Dim HASHEDPASS As String

' Flag to check Sheet Protect and Window/Structure Protect
Dim SheetFlag As Boolean, WinFlag As Boolean

' Default value sheet Protection is disabled, Window/Structure Protection disabled
SheetFlag = False
WinFlag = False

Application.ScreenUpdating = False
With ActiveWorkbook
' On ActiveWorkbook check for Structure/Window Protection
WinFlag = .ProtectStructure Or .ProtectWindows
End With

' Check for all WorkSheets in the ActiveWorkbook for Sheet Protection
For Each ws1 In Worksheets
SheetFlag = SheetFlag Or ws1.ProtectContents
Next ws1

'-------------------------------------------------------------------------------------------------------------------
'| SheetFlag | Structure/Window Flag (WinFlag) | Description |
'--------------------------------------------------------------------------------------------------------------------
'| 0 | 0 | - Both Protection are Disabled. |
'| 0 | 1 | - Only Window/Structure Protection is Enabled. |
'| 1 | 0 | - Only Sheet Protection is Enabled. |
'| 1 | 1 | - Both Protection are Enabled. |
'--------------------------------------------------------------------------------------------------------------------

' SheetFlag - 0 WinFlag - 0 ===> Both Protection are Disabled.
If Not SheetFlag And Not WinFlag Then
' No Password found on the workbook. Neither Sheet protection nor Window/Structure Protection
MsgBox NOPROTECTIONMSG, vbInformation, HEADER
Exit Sub
End If

' Display Time Alert
Dim iReturn As Integer
iReturn = MsgBox(TIMEALERT, vbOKCancel, HEADER)

' Check pressed button
If iReturn = vbCancel Then
Exit Sub
End If

' 0 | 1 - Only Window/Structure Protection is Enabled.
' 1 | 0 - Only Sheet Protection is Enabled.
' 1 | 1 - Both Protection are Enabled.

If WinFlag Or SheetFlag Then
On Error Resume Next

' WinFlag - 1 Window/Structure Protection is Enabled.
If WinFlag Then
Do 'dummy do loop
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

With ActiveWorkbook
.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

' Save the Hased Password
If .ProtectStructure = False And _
.ProtectWindows = False Then
HASHEDPASS = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

' Window/Structure Protection Unlocked.
MsgBox Application.Substitute(BOOKPROTECTIONFOUND, _
"$$", HASHEDPASS), vbInformation, HEADER
Exit Do 'Bypass all for...nexts
End If
End With
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True ' End Dummy DO Loop
On Error GoTo 0

' WinFlag - 0 Only Window/Structure Protection is not Enabled.
Else
MsgBox NOBOOKPROTECTION, vbInformation, HEADER
End If


If WinFlag And Not SheetFlag Then
MsgBox ONLYBOOKPROTECTION, vbInformation, HEADER
Exit Sub
End If

If SheetFlag Then
On Error Resume Next
For Each ws1 In Worksheets
'Attempt clearance with HASHEDPASSWORD
ws1.Unprotect HASHEDPASS
Next ws1
On Error GoTo 0
SheetFlag = False
For Each ws1 In Worksheets
'Checks for all clear SheetFlag triggered to 1 if not.
SheetFlag = SheetFlag Or ws1.ProtectContents
Next ws1
If SheetFlag Then
For Each ws1 In Worksheets
With ws1
If .ProtectContents Then
On Error Resume Next
Do 'Dummy do loop
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If Not .ProtectContents Then
HASHEDPASS = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
MsgBox Application.Substitute(SHEETPROTECTIONFOUND, _
"$$", HASHEDPASS), vbInformation, HEADER
'leverage finding HASHEDPASS by trying on other sheets
For Each ws2 In Worksheets
ws2.Unprotect HASHEDPASS
Next ws2
Exit Do 'Bypass all for...nexts
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If
End With
Next ws1
End If
End If
MsgBox ALLCLEAR & AUTHORS & VERSION & FEEDBACK, vbInformation, HEADER
End If
End Sub

-----------------------------------------------------------------------------------------------