Auto Protect

pradyuthal

Board Regular
Joined
Jul 13, 2005
Messages
212
I have the following Vb code with which I can suceesfully protect and unprotect formula cells. I want to get the unprotected formula cells ( with the help of unprotect vb code ) protected automatically whenever i close the excel file.

Code:
Sub lock_formulas()
'Erik Van Geit
'060914

Dim SH As Worksheet
Dim rng As Range

On Error Resume Next

    For Each SH In Worksheets
    SH.Unprotect
    
        With SH.UsedRange
        .Locked = False
        Set rng = Nothing
        Set rng = .SpecialCells(xlCellTypeFormulas)
        If Not rng Is Nothing Then rng.Locked = True
        End With
        
    SH.Protect
    Next SH

End Sub

Code:
Sub unlock_formulas()
'Erik Van Geit
'060914

Dim SH As Worksheet
Dim rng As Range

On Error Resume Next

    For Each SH In Worksheets
    SH.Unprotect
    
        With SH.UsedRange
        .Locked = False
        Set rng = Nothing
        Set rng = .SpecialCells(xlCellTypeFormulas)
        If Not rng Is Nothing Then rng.Locked = False
        End With
        
    SH.Unprotect
    Next SH

End Sub

EDIT:

The mind of an Excel-lover is full of structure. It loves reading code which is indented: analysing is quicker: so every effort can go to the problem itself...

Added Code tags - Smitty
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Smitty

Legend
Joined
May 15, 2003
Messages
29,536
How about using the Before Close event:

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call lock_formulas
End Sub

HTH,

Smitty
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
The mind of an Excel-lover is full of structure. It loves reading code which is indented: analysing is quicker: so every effort can go to the problem itself...

To let the code stay indented do the following.
Click "reply"
write your message
select your code
click the "Code"-button
(or Click code button, paste your code, click "Code" button again.)
Submit

A real relief for those who try to help you !
Code:
Sub lock_formulas() 
'Erik Van Geit 
'060914 

Dim SH As Worksheet 
Dim rng As Range 

On Error Resume Next 

    For Each SH In Worksheets 
    SH.Unprotect 
    
        With SH.UsedRange 
        .Locked = False 
        Set rng = Nothing 
        Set rng = .SpecialCells(xlCellTypeFormulas) 
        If Not rng Is Nothing Then rng.Locked = True 
        End With 
        
    SH.Protect 
    Next SH 

End Sub
 

pradyuthal

Board Regular
Joined
Jul 13, 2005
Messages
212
Code:
The following code protects all the blank cells also in addition to the cells containing formulas . But I  do not want to protect blank ones .
Please modify the following code .
Sub lock_formulas() 
'Erik Van Geit 
'060914 

Dim SH As Worksheet 
Dim rng As Range 

On Error Resume Next 

    For Each SH In Worksheets 
    SH.Unprotect 
    
        With SH.UsedRange 
        .Locked = False 
        Set rng = Nothing 
        Set rng = .SpecialCells(xlCellTypeFormulas) 
        If Not rng Is Nothing Then rng.Locked = True 
        End With 
        
    SH.Protect 
    Next SH 

End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832

ADVERTISEMENT

thank you for indenting the code :)

it doens't lock the blank cells for me: I can still write in them
also the constants are not protected

try out an extra line rng.select to check
the affected range will be selected
are there cells selected which you didn't expect ?
Code:
Sub lock_formulas()
'Erik Van Geit
'060914

Dim SH As Worksheet
Dim rng As Range

On Error Resume Next

    For Each SH In Worksheets
    SH.Unprotect
        With SH.UsedRange
        .Locked = False
        Set rng = Nothing
        Set rng = .SpecialCells(xlCellTypeFormulas)
            If Not rng Is Nothing Then
            rng.Locked = True
            rng.Select
            End If
        End With
        
    SH.Protect
    Next SH

End Sub
kind regards,
Erik
 

pradyuthal

Board Regular
Joined
Jul 13, 2005
Messages
212
Code:
This code works fine by selecting the affected cells .

But the following code as suggested does not work in all workbooks :

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    Call lock_formulas 
End Sub

I get the lock_formula and unlock_formulas code worked by way of integrating these by creating a menu with the help of the following code :

    Option Explicit
    
Sub CreateMenu()
'   This sub should be executed when the workbook is opened.
'   NOTE: There is no error handling in this subroutine

    Dim MenuSheet As Worksheet
    Dim MenuObject As CommandBarPopup

    Dim MenuItem As Object
    Dim SubMenuItem As CommandBarButton
    Dim Row As Integer
    Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId

''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Location for menu data
    Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
''''''''''''''''''''''''''''''''''''''''''''''''''''

'   Make sure the menus aren't duplicated
    Call DeleteMenu
    
'   Initialize the row counter
    Row = 2

'   Add the menus, menu items and submenu items using
'   data stored on MenuSheet
    
    Do Until IsEmpty(MenuSheet.Cells(Row, 1))
        With MenuSheet
            MenuLevel = .Cells(Row, 1)
            Caption = .Cells(Row, 2)
            PositionOrMacro = .Cells(Row, 3)
            Divider = .Cells(Row, 4)
            FaceId = .Cells(Row, 5)
            NextLevel = .Cells(Row + 1, 1)
        End With
        
        Select Case MenuLevel
            Case 1 ' A Menu
'              Add the top-level menu to the Worksheet CommandBar
                Set MenuObject = Application.CommandBars(1). _
                    Controls.Add(Type:=msoControlPopup, _
                    Before:=PositionOrMacro, _
                    Temporary:=True)
                MenuObject.Caption = Caption
            
            Case 2 ' A Menu Item
                If NextLevel = 3 Then
                    Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
                Else
                    Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
                    MenuItem.OnAction = PositionOrMacro
                End If
                MenuItem.Caption = Caption
                If FaceId <> "" Then MenuItem.FaceId = FaceId
                If Divider Then MenuItem.BeginGroup = True
            
            Case 3 ' A SubMenu Item
                Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
                SubMenuItem.Caption = Caption
                SubMenuItem.OnAction = PositionOrMacro
                If FaceId <> "" Then SubMenuItem.FaceId = FaceId
                If Divider Then SubMenuItem.BeginGroup = True
        End Select
        Row = Row + 1
    Loop
End Sub

Sub DeleteMenu()
'   This sub should be executed when the workbook is closed
'   Deletes the Menus
    Dim MenuSheet As Worksheet
    Dim Row As Integer
    Dim Caption As String
    
    On Error Resume Next
    Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
    Row = 2
    Do Until IsEmpty(MenuSheet.Cells(Row, 1))
        If MenuSheet.Cells(Row, 1) = 1 Then
            Caption = MenuSheet.Cells(Row, 2)
            Application.CommandBars(1).Controls(Caption).Delete
        End If
        Row = Row + 1
    Loop
    On Error GoTo 0
End Sub

This code is written the excel sheet under Microsoft Excel Object [Sheet1(Menusheet)]

Private Sub Workbook_Open()
    Call CreateMenu
    
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call DeleteMenu
End Sub

Please help me by providing a suitable vb code so that I can apply the method , that is , whenever I close any workbook containing the unprotected formula cells get protected automatically
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
please post your explanatory text normally and your code
Code:
between codetags

I do not see why you are posting code about creating menus
this has no influence on the code itself

if you can make it work on one sheet, you can make it work on any sheet ...
I'm not sure what you mean by
This code works fine by selecting the affected cells .
does the code work as intended ?? (not talking about other workbooks, but just the active workbook)
Code:
Sub lock_formulas() 
'Erik Van Geit 
'060914 

Dim SH As Worksheet 
Dim rng As Range 

On Error Resume Next 

    For Each SH In Worksheets 
    SH.Unprotect 
        With SH.UsedRange 
        .Locked = False 
        Set rng = Nothing 
        Set rng = .SpecialCells(xlCellTypeFormulas) 
            If Not rng Is Nothing Then 
            rng.Locked = True 
            rng.Select 
            End If 
        End With 
        
    SH.Protect 
    Next SH 

End Sub
it is protecting all formulacells on all sheets, nothing else, nothing less

best regards,
Erik
 

Forum statistics

Threads
1,136,308
Messages
5,674,993
Members
419,541
Latest member
freddyboots

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
Top