• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

locking and unlocking cells

Status
Not open for further replies.

odartey

Member
Hello All,

I got this code which is working very very well.

But i want to edit the code such that it works from the worksheet instead of This workbook where the locking applies to all active sheets.
What i want the code to achieve is to apply it to just two of the worksheets in the workbook than to all of the active sheets in the workbook.

ie, if i have 30 active worksheets in the workbook, it should apply just to TWO of the worksheets.

Any help please ..............

Kind Regards

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

On Error Resume Next

'Resume to next line if any error occurs

Dim Cell As Range

With ActiveSheet

'first of all unprotect the entire

'sheet and unlock all cells

.Unprotect Password:="xx"

.Cells.Locked = False

'Now search for non blank cells

'and lock them and unlock blank cells

For Each Cell In ActiveSheet.UsedRange

If Cell.Value = "" Then

Cell.Locked = False

Else

Cell.Locked = True

End If

Next Cell

.Protect Password:="xx"

'Protect with blank password, you can change it

End With

Exit Sub

End Sub
 
Closed at author's request. (solved via pm)
Solution code:
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

On Error Resume Next

'Resume to next line if any error occurs

Dim c As Range
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    'Check if this is a sheet we care about
    If ws.Name = "Sheet1" Or ws.Name = "Sheet2" Then

        With ws
       
            'first of all unprotect the entire
            'sheet and unlock all cells
           
            .Unprotect Password:="xx"
           
            'faster method, instead of looping through all cells
            'use the special cells to get them all in 1 shot
            .UsedRange.Cells.Locked = True
            .UsedRange.SpecialCells(xlCellTypeBlanks).Locked = False
               
            .Protect Password:="xx"
           
            'Protect with blank password, you can change it
       
        End With
    End If
Next ws

End Sub
 
Status
Not open for further replies.
Back
Top