Using macro to sign and lock spreadsheet - but failed!

[Koala123]

Hi there. The below is done by a previous colleague and the purpose is to allow people to "click-sign" the spreadsheet, and after signed the spread is supposed to be locked and no one can change any data. Unless the original signer removes signature then sheet will be unprotected.

But there problem is after it's signed, the bank details sections (merged cells) are not locked, which means people are still able to change that part after sheet is signed. I believe it's not good so would like to fix this loophole.

Not sure how can I change the below coding to make the whole sheet locked after signing? Can anyone please help?

Thanks in advance!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim A As Worksheet: Set A = ActiveSheet
    Dim Sign As String: Sign = Application.UserName & " - " & WorksheetFunction.Text(Now(), "DD MMM YYYY hh:mm:ss")
    
    'Detect if selected cell is a check cell
    If Not (Application.Intersect(Target, Range("Check.Prep")) Is Nothing) Then
        'Detect if the check cell has been signed already
        If ActiveCell.Text <> "" Then
            'Check cell is signed, provide dialogue box
            If Left(ActiveCell.Text, InStr(1, ActiveCell.Text, " - ") - 1) = Application.UserName Then
                If MsgBox("Do you want to remove this signature?", vbOKCancel, "Delete Signature") = vbOK Then
                    A.Unprotect "abc"
                    ActiveCell.Cells(1, 1).Value = ""
                    ActiveCell.Offset(1, 0).Select
                    'LockSheet A, "abc"
                End If
            Else
                MsgBox "Sorry, but signature can only be removed by the original signatory", vbInformation
            End If
        Else
            'Check cell is not signed, create electronic signature
            A.Unprotect "abc"
            ActiveCell.Value = Sign
            Dim i As Long: i = 0
            ActiveCell.Offset(1, 0).Select
            LockSheet A, "abc"
        End If
    End If
    Application.Calculation = xlCalcul
End Sub

 

[breynolds0431]

Try adding ActiveSheet.Cells.Locked = True above the sheet protection such as the below.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim A As Worksheet: Set A = ActiveSheet
    Dim Sign As String: Sign = Application.UserName & " - " & WorksheetFunction.Text(Now(), "DD MMM YYYY hh:mm:ss")
    
    'Detect if selected cell is a check cell
    If Not (Application.Intersect(Target, Range("Check.Prep")) Is Nothing) Then
        'Detect if the check cell has been signed already
        If ActiveCell.Text <> "" Then
            'Check cell is signed, provide dialogue box
            If Left(ActiveCell.Text, InStr(1, ActiveCell.Text, " - ") - 1) = Application.UserName Then
                If MsgBox("Do you want to remove this signature?", vbOKCancel, "Delete Signature") = vbOK Then
                    A.Unprotect "abc"
                    ActiveCell.Cells(1, 1).Value = ""
                    ActiveCell.Offset(1, 0).Select
                    'LockSheet A, "abc"
                End If
            Else
                MsgBox "Sorry, but signature can only be removed by the original signatory", vbInformation
            End If
        Else
            'Check cell is not signed, create electronic signature
            A.Unprotect "abc"
            ActiveCell.Value = Sign
            Dim i As Long: i = 0
            ActiveCell.Offset(1, 0).Select
            '>>>This will lock all cells in worksheet
            ActiveSheet.Cells.Locked = True
            LockSheet A, "abc"
        End If
    End If
    Application.Calculation = xlcalcul
End Sub

 

[Koala123]

Try adding ActiveSheet.Cells.Locked = True above the sheet protection such as the below.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim A As Worksheet: Set A = ActiveSheet
    Dim Sign As String: Sign = Application.UserName & " - " & WorksheetFunction.Text(Now(), "DD MMM YYYY hh:mm:ss")
   
    'Detect if selected cell is a check cell
    If Not (Application.Intersect(Target, Range("Check.Prep")) Is Nothing) Then
        'Detect if the check cell has been signed already
        If ActiveCell.Text <> "" Then
            'Check cell is signed, provide dialogue box
            If Left(ActiveCell.Text, InStr(1, ActiveCell.Text, " - ") - 1) = Application.UserName Then
                If MsgBox("Do you want to remove this signature?", vbOKCancel, "Delete Signature") = vbOK Then
                    A.Unprotect "abc"
                    ActiveCell.Cells(1, 1).Value = ""
                    ActiveCell.Offset(1, 0).Select
                    'LockSheet A, "abc"
                End If
            Else
                MsgBox "Sorry, but signature can only be removed by the original signatory", vbInformation
            End If
        Else
            'Check cell is not signed, create electronic signature
            A.Unprotect "abc"
            ActiveCell.Value = Sign
            Dim i As Long: i = 0
            ActiveCell.Offset(1, 0).Select
            '>>>This will lock all cells in worksheet
            ActiveSheet.Cells.Locked = True
            LockSheet A, "abc"
        End If
    End If
    Application.Calculation = xlcalcul
End Sub

Hey Breynolds this has fixed the issue, thank you very much!