Unprotect macro sheets problem

pbt

Well-known Member
Joined
Oct 18, 2005
Messages
1,613
Code:
Private Sub unprotect()
Dim Sh As Worksheet
For Each Sh In ActiveWorkbook.Worksheets
        Sh.unprotect Password:="Happy Feet"
Next Sh
End Sub

When I run this, it gives error 1004 - Password supplied is incorrect. Verify CapsLock is off ..... etc.

Yet when I go into each sheet, Tools > Protection > Unprotect, and type in the password, my sheets get unprotected.

This one has me stumped.

Harry
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Okay, I had a few views on this thread but no replies.

Possible that since this routine is so simple that a solution is not possible without seeing the whole Project: Here it is:

In the Thisworkbook module
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 bIsClosing = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Cancel = True Or bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub

Private Sub Workbook_Deactivate()
If bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub
Private Sub Workbook_Open()
Run "ShowAll"
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
 Sh.Protect Password:="Happy Feet", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sh.EnableSelection = xlUnlockedCells
Next Sh
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Msg, Style, Title, Response
Dim r As Range
'//change cells to uppercase.
    Dim rng1 As Range, rng2 As Range, cell As Range, rng3 As Range, rng4 As Range
    On Error GoTo errTrap
    Application.EnableEvents = False
    If Not Intersect(Target, Rows(4)) Is Nothing Then
        Set rng3 = Intersect(Target, Rows(4))
        Set rng4 = Intersect(ActiveSheet.UsedRange, rng3)
        For Each cell In rng3
            If cell.Formula <> "" Then
                cell.Formula = Format(cell.Formula, ">")
            End If
        Next cell
    End If
    If Not Intersect(Target, Rows(7)) Is Nothing Then
        Set rng1 = Intersect(Target, Rows(7))
        Set rng2 = Intersect(ActiveSheet.UsedRange, rng1)
        For Each cell In rng1
            If cell.Formula <> "" Then
                cell.Formula = Format(cell.Formula, ">")
            End If
        Next cell
    End If

If Intersect(Target, Range("C7:Q7")) Is Nothing Then GoTo errTrap

If Not IsEmpty(Cells(10, Target.Column)) Or Target.Cells.Count > 1 Then GoTo errTrap
If Target.Value = "PT" Then
Msg = "If you intend to use this Labor Code,   PT   for Patch" _
      & vbCrLf & "Please enter your AWA Number in row 10 below" _
      & vbCrLf & vbCrLf & "And don't forget to include a copy of the AWA with payroll" _
        & vbCrLf & "                   No AWA,   No PAY"
   Style = vbOKOnly
    Title = "                                 REMINDER"
    Response = MsgBox(Msg, Style, Title)
        If Response = vbOK Then
    End If
    End If
    
    'If you have any worksheet to exclude
If Sh.Name = "Sheet2" Then Exit Sub
For Each r In Target
     If Len(r.Value) <> Len(Trim(r.Value)) Then
             MsgBox "You just entered a leading space character in" & vbCrLf & _
         "                     cell " & r.Address(0, 0) & "." & vbCrLf & vbCrLf & _
"If you intend to delete the value in that or any cell, " & vbCrLf & _
"please press the Delete button on your keyboard.", 16, "         No leading spaces allowed !!"

          Application.EnableEvents = False
             r.Value = Trim(r.Value)
          Application.EnableEvents = True
     End If
Next
errTrap:
 Application.EnableEvents = True
End Sub

Module 1:
Code:
Public bIsClosing As Boolean
Dim wsSheet As Worksheet

Sub HideAll()

Application.ScreenUpdating = False
For Each wsSheet In ThisWorkbook.Worksheets
    If wsSheet.CodeName = "Sheet1" Then
     wsSheet.Visible = xlSheetVisible
    Else
     wsSheet.Visible = xlSheetVeryHidden
    End If
Next wsSheet
Application.ScreenUpdating = True

End Sub

Sub ShowAll()
bIsClosing = False
Application.ScreenUpdating = False
For Each wsSheet In ThisWorkbook.Worksheets
    If wsSheet.CodeName <> "Sheet1" Then
     wsSheet.Visible = xlSheetVisible
    End If
Next wsSheet

Sheet1.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
End Sub
Sub test()
Dim Sh As Worksheet
For Each Sh In Sheets
 Sh.Visible = True
Next Sh
End Sub
Sub test2()
bIsClosing = True
End Sub

Module 2 has the posted code above to unprotect all the sheets if I need to do adjustments to all sheets at once.

As you can see with the code. I am trying to Force Enable Macros, which does work. Just can't run the unprotect procedure.

Harry
 
Upvote 0
Are you sure ALL sheets have the password "Happy Feet" ??

I notice in your HideAll Code, you exclude 1 sheet "Sheet1"
I assume that is the sheet you want shown to users who don't enable macros..

In the code you're having the problem, it goes through ALL sheets, and Sheet1 may be the first one...

try adding a message box with the sheet name prior to the unprotect, this will tell you which sheet it's having a problem with...

Code:
Private Sub unprotect()
Dim Sh As Worksheet
For Each Sh In ActiveWorkbook.Worksheets
        msgbox Sh.Name
        Sh.unprotect Password:="Happy Feet"
Next Sh
End Sub
 
Upvote 0
Thanks jonmo1

That was dead on. It was Sheet1 which did have a different password then the rest. Don't know how that happened, but I got it fixed now.

Thank you and have a great day
Harry
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

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