Prevent changes to a single column

[tiredofit]

Let's assume I have the numbers 1,2,3 in cells A1 through to A3 and the numbers 2,3,4 in cells B1 through to D1.

This is the code to prevent changes to column A:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rng As Range

    For Each rng In Target.Cells   
        If rng.Column = 1 Then Call Reverse
    Next rng
    
    Set rng = Nothing
    
End Sub

Private Sub Reverse()

    With Application    
        .EnableEvents = False
        .Undo
        .EnableEvents = True
    End With
    
End Sub

It works as expected if only a single cell is changed.

For example, if I attempt to change the value in cell A1 to say f, the code reverses the change and cell A1 shows the value of 1.

However, if I highight cells A1 and B1, then type something, say e and press Ctrl + Enter, the code reverses the action (and cell A1 shows 1 and cell B1 shows 2 as originally) but what I want is for cell A1 to show the value of 1 (because it's reversed the action) and cell B1 to show the newly entered value of e.

How can I amned my code to achieve this?

Thanks

 

[Cubist]

Try this:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim colAChanged As Boolean
    Dim nonColAValues As Variant
    Dim cell As Range
    Dim r As Long, c As Long

    ' Check if any cell in column A was changed
    For Each cell In Target
        If cell.Column = 1 Then
            colAChanged = True
            Exit For
        End If
    Next cell

    ' If column A was changed, store values and undo
    If colAChanged Then
        nonColAValues = Target.Value

        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
       
        ' Restore the stored values only for cells not in column A
        For r = 1 To UBound(nonColAValues, 1)
            For c = 1 To UBound(nonColAValues, 2)
                If Target.Cells(r, c).Column <> 1 Then
                    Target.Cells(r, c).Value = nonColAValues(r, c)
                End If
            Next c
        Next r
    End If

End Sub

 

[Cubist]

Amend to handle single cell, 1-D and 2-D array changes.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim colAChanged As Boolean
    Dim nonColAValues As Variant
    Dim cell As Range
    Dim r As Long, c As Long

    For Each cell In Target
        If cell.Column = 1 Then
            colAChanged = True
            Exit For
        End If
    Next cell

    If colAChanged Then
        ' Store the original values of the range before undoing
        nonColAValues = Target.Value

        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True

 
        If IsArray(nonColAValues) Then
            ' Restore the stored values only for cells not in column A
            For r = 1 To UBound(nonColAValues, 1)
                For c = 1 To UBound(nonColAValues, 2)
                    If Target.Cells(r, c).Column <> 1 Then
                        Target.Cells(r, c).Value = nonColAValues(r, c)
                    End If
                Next c
            Next r
        Else
 
            If Target.Column <> 1 Then
                Target.Value = nonColAValues
            End If
        End If
    End If

End Sub

 

[tiredofit]

Amend to handle single cell, 1-D and 2-D array changes.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim colAChanged As Boolean
    Dim nonColAValues As Variant
    Dim cell As Range
    Dim r As Long, c As Long

    For Each cell In Target
        If cell.Column = 1 Then
            colAChanged = True
            Exit For
        End If
    Next cell

    If colAChanged Then
        ' Store the original values of the range before undoing
        nonColAValues = Target.Value

        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True

 
        If IsArray(nonColAValues) Then
            ' Restore the stored values only for cells not in column A
            For r = 1 To UBound(nonColAValues, 1)
                For c = 1 To UBound(nonColAValues, 2)
                    If Target.Cells(r, c).Column <> 1 Then
                        Target.Cells(r, c).Value = nonColAValues(r, c)
                    End If
                Next c
            Next r
        Else
 
            If Target.Column <> 1 Then
                Target.Value = nonColAValues
            End If
        End If
    End If

End Sub

Thanks, this is what I was seeking.