Thread: Confirmation pop-up on cell value change

Hello, all! I need help with getting a confirmation pop-up message with Yes and No buttons that confirms user's intention to change cell's value on the sheet. In my project, this pop-up message should only work in columns D, E, and F. The reason for the pop-up is to prevent accidental change of data in these columns.

I think is is going to get pretty annoying for the user, but here is one way to go about it - modify as required.

The code needs to go into the sheet module.

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim response As Variant, msg As String
    
    msg = "You have changed the data - please confirm this change is intended"
    
    If Target.Count > 1 Then Exit Sub
    
    If Not Intersect(Target, Columns("D:F")) Is Nothing Then
        response = MsgBox(msg, vbYesNo + vbExclamation)
        Select Case response
            Case vbYes
                Exit Sub
                
            Case vbNo
                MsgBox ("Please correct the entry as required")
        End Select
    End If
    
End Sub

Try this

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OldValue As Variant
    If Not Intersect(Target, Range(Cells(1, 4), Cells(Rows.Count, 6))) Is Nothing Then
        Application.EnableEvents = False
        OldValue = Target.Value
        Select Case MsgBox("Are you sure that you want to change "" & Target.Address", _
                           vbYesNo Or vbQuestion Or vbDefaultButton1, "Confirm change...")
            Case vbYes
                Exit Sub
            Case vbNo
                Target.Value = OldValue
        End Select
    End If
    Application.EnableEvents = True
End Sub

Copy the code
Select the worksheet in which you the code to run
Right click on the sheet tab and choose View Code, to open the Visual Basic Editor.
Where the cursor is flashing, choose Edit | Paste

Thank you very much, Palmetto. This is very close to what I want, but I do not want this message to pop up if I just double-clicked the cell but made no changes and if the change was made and I click "No" to accept the change, your code generates a message advising to correct the entry as required. Is it possible that it just puts back the old value?

The code is RoyUK's post is closer to what you want and should do the job. Give it a try and if need further refinement, post back.

Fixed it

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim OldValue As Variant
    If Not Intersect(Target, Columns("D:F")) Is Nothing Then
        Application.EnableEvents = False
        OldValue = Target.Value
        Select Case MsgBox("Are you sure that you want to change " & Target.Address, _
                           vbYesNo Or vbQuestion Or vbDefaultButton1, "Confirm change...")
            Case vbYes
                GoTo exit_handler
            Case vbNo
                Target.Value = OldValue
        End Select
    End If
exit_handler:
    Application.EnableEvents = True
End Sub

This should work

Code:

Option Explicit
   Dim OldValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("D:F")) Is Nothing Then
        Application.EnableEvents = False
        Select Case MsgBox("Are you sure that you want to change " & Target.Address, _
                           vbYesNo Or vbQuestion Or vbDefaultButton1, "Confirm change...")
            Case vbYes
                GoTo exit_handler
            Case vbNo
                Target.Value = OldValue
        End Select
    End If
exit_handler:
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    OldValue = Target.Value
End Sub

Here's another way ...

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vNew        As Variant
    Dim vOld        As Variant

    With Target
        If .Count > 1 Or Intersect(.Cells, Columns("D:F")) Is Nothing Then Exit Sub
        vNew = .Value
        Application.EnableEvents = False
        Application.Undo
        vOld = .Value
        .Value = vNew
        If MsgBox(Prompt:="Change value??", _
                  Buttons:=vbYesNo + vbQuestion + vbDefaultButton2, _
                  Title:="Are you sure??") = vbNo Then
            .Value = vOld
        End If
        Application.EnableEvents = True
    End With
End Sub

remove the $ with subtitut

Code:

Option Explicit
Dim OldValue   As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sAddress As String
    If Not Intersect(Target, Columns("D:F")) Is Nothing Then
        sAddress = Target.Address
        sAddress = WorksheetFunction.Substitute(sAddress, "$", "")

        Application.EnableEvents = False
        Select Case MsgBox("Are you sure that you want to change " & sAddress, _
                           vbYesNo Or vbQuestion Or vbDefaultButton1, "Confirm change...")
            Case vbYes
                GoTo exit_handler
            Case vbNo
                Target.Value = OldValue
        End Select
    End If
exit_handler:
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    OldValue = Target.Value
End Sub

Or

Code:

Option Explicit
Dim OldValue   As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("D:F")) Is Nothing Then
        Application.EnableEvents = False
        Select Case MsgBox("Are you sure that you want to change " & sAddress(Target), _
                           vbYesNo Or vbQuestion Or vbDefaultButton1, "Confirm change...")
            Case vbYes
                GoTo exit_handler
            Case vbNo
                Target.Value = OldValue
        End Select
    End If
exit_handler:
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    OldValue = Target.Value
End Sub

Function sAddress(TheRange As Range) As String
  sAddress = TheRange.Address
        sAddress = WorksheetFunction.Substitute(sAddress, "$", "")
End Function