Verifying Sheet Changes

Hello Everyone,

I'm Gadi, Eric presented me in the blog last month. Starting from today I'll periodically write posts in ExcelGeek.com, it's something I promised to help Eric with, as part of our collaboration on projects. It is my pleasure to share my knowledge with others. I'll try to post neat Excel tricks, which some of you may find useful (I hope).

My first post I would like to dedicate to a solution which I lately applied at my work place, related to verifying with the user, whether the changes he made to certain critical fields in the worksheet were made deliberately or by accident. An alternative solution could have been to protect the workbook, however I did want to allow users the ability to change these values. The solution is based on a message box, that pops up whenever a sensitive cell is being changed. It prompts the user to confirm the change of the cell.

The following code has to be placed in a sheet module. Copy paste it into the modules of the sheets where you want to enable user's confirmation on any changes made to sensitive data cells. Change the VerifyRng to the range where you want the confirmation message to popup. In the following code it is set to any cell in column A.

Public Trigger As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Resets the trigger if a new cell is selected.

    Trigger = False

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Verifies that the user deliberately changed data in column A.

    Dim LastRow As Integer
    Dim VerifyRng As Range
    Dim Response

    If Trigger = False Then

        Set VerifyRng = Columns(1)
        'Change this variable to your desired range
        
        If Not Intersect(Target, VerifyRng) Is Nothing Then
            Response = MsgBox("You are about to change the cell " & Target.Address(False, False) & _
                "." & Chr(13) & Chr(13) & "Are you sure you want to modify this cell?", _
                vbYesNo, "Cell Change Alert")
    
            If Response = vbNo Then
                Trigger = True
                Application.Undo
            End If
    
        End If
    
    End If

End Sub