1
votes
  • I have an Excel spreadsheet that contains 7 worksheets.
  • I need the script below to be applied to only some of the worksheets (Sheet6 & Sheet7) whenever the document is saved.

I've spent several hours trying different modifications, must of which simply did not work. The VBA debugger does not throw any errors, and when I test the script it never appears to run.

How can the script below be modified to run against specific worksheets, whenever I save the document from any of the worksheet tabs?

Thank you


VBA - Lock Cells & Protect Sheet On Save

The script below will lock cells that contain values, and then password protect the sheet before saving.

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

    On Error Resume Next
    Dim Cell As Range
    With ActiveSheet
        .Unprotect Password:=""
        .Cells.Locked = False
        For Each Cell In Application.ActiveSheet.UsedRange
            If Cell.Value = "" Then
                Cell.Locked = False
            Else
                Cell.Locked = True
            End If
        Next Cell
        .Protect Password:=""
         'Protect with blank password, you can change it
    End With
    Exit Sub
End Sub

Script Source

3
Sorry for the late reply. Thanks to all of you skillful code examples!SirKit

3 Answers

1
votes

Change the ActiveSheet and use a For Each loop like so:

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

    On Error Resume Next
    Dim Cell As Range
    For Each sh In Array("Sheet1", "AnotherSheet", "OtherSheet")   
        With Sheets(sh)
            .Unprotect Password:=""
            .Cells.Locked = False
                For Each Cell In Application.ActiveSheet.UsedRange
                    If Cell.Value = "" Then
                        Cell.Locked = False
                    Else
                        Cell.Locked = True
                    End If
                Next
            .Protect Password:=""
        End With
    Next
End Sub
0
votes

This should help you (you'll have messages to let you know when you are in the event and when it's started and over) :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Cell As Range
MsgBox "Event Workbook_BeforeSave Launched", vbInformation + vbOKOnly, "Started"

On Error GoTo ErrHandler

ReTry:
    With Sheet6
        .Unprotect Password:=""
        .Cells.Locked = False
        For Each Cell In .UsedRange
            If Cell.Value = "" Then
                Cell.Locked = False
            Else
                Cell.Locked = True
            End If
        Next Cell
        .Protect Password:=""
        'Protect with blank password, you can change it
    End With
    With Sheet7
        .Unprotect Password:=""
        .Cells.Locked = False
        For Each Cell In .UsedRange
            If Cell.Value = "" Then
                Cell.Locked = False
            Else
                Cell.Locked = True
            End If
        Next Cell
        .Protect Password:=""
        'Protect with blank password, you can change it
    End With

MsgBox "Event Workbook_BeforeSave Over", vbInformation + vbOKOnly, "Finished"
    Exit Sub
ErrHandler:
    MsgBox "Error " & Err.Number & " :" & vbCrLf & _
        Err.Description
    Resume ReTry

End Sub
0
votes

The code can be significantly shorted (run time wise) by

  • Using SpecialCells rather than looping through each cell
  • avoiding setting blank cells as being locked twice (minor compared to first point).

updated

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

For Each sh In Array("Sheet1", "AnotherSheet", "OtherSheet")
        With Sheets(sh)
            .Unprotect
            .Cells.Locked = True
                On Error Resume Next
                .Cells.SpecialCells(xlBlanks).Locked = False
                On Error GoTo 0
            .Protect
        End With
    Next
End Sub