Ask Me Help Desk

Ask Me Help Desk (https://www.askmehelpdesk.com/forum.php)
-   Spreadsheets (https://www.askmehelpdesk.com/forumdisplay.php?f=395)
-   -   Lock only filled up cells during saving (https://www.askmehelpdesk.com/showthread.php?t=461739)

  • Apr 1, 2010, 04:04 AM
    kvinay_00
    1 Attachment(s)
    Lock only filled up cells during saving
    I wish to lock the cells in a particular sheet ("CMstr", see attachment) in which user has entered data and balance cells to be remained unlocked.

    The cells should get locked when the user saves the workbook with a Warning Message (like - to check the data entered is correct/ cells will be locked after saving etc).

    Some other conditions also need to be met as per sheet no "2". VB codes for these conditions are available for reference.

    Can anybody help please?

    Thanks in advance.
  • Apr 2, 2010, 06:34 AM
    JBeaucaire

    1) Take the code out of the CMstr sheet module.

    2) Replace this macro in your ThisWorkbook module:
    Code:

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim myWS As Worksheet
    Cancel = True

        For Each myWS In Worksheets
            If myWS.Range("t51").Value = "Check Culprit Code Allocation" Then
                MsgBox "Please check culprit code allocation on Sheet No." & myWS.Name
                Exit Sub
            End If
        Next myWS

        If SaveAsUI = True Then
            MsgBox "SaveAs not allowed.  Use Save."
            Exit Sub
        End If
       
        If MsgBox("Saving this workbook will lock the entries completed so far and you will no longer be able to edit them. Do you really want to save the workbook now?", vbYesNo) _
            = vbNo Then Exit Sub
           
        Call UpdateAndSaveSheet

    End Sub

    3) Add this to the bottom of the code in the ThisWorkbook module:

    Code:

    Private Sub UpdateAndSaveSheet()
    Dim LastRow As Long, ws As Worksheet
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For Each ws In Sheets(Array("CMstr"))  'extend this array to include all your sheets by name
        ws.Protect UserInterfaceOnly:=True
    '    ws.Protect Password:="vinay", UserInterfaceOnly:=True
       
        LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        If LastRow < 3 Then GoTo FinishLine
       
        With ws.Range("A3:H" & LastRow)
            .Locked = True
            .Interior.ColorIndex = 37
        End With

    Next ws

    FinishLine:
        ThisWorkbook.Save
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End Sub

  • Apr 3, 2010, 01:39 AM
    kvinay_00

    Thank you JBeaucaire !

  • All times are GMT -7. The time now is 10:21 AM.