Home » excel » excel – VBA prevent user changing cell value with reference to only the initial cell value

excel – VBA prevent user changing cell value with reference to only the initial cell value

Posted by: admin May 14, 2020 Leave a comment

Questions:

I’m trying to stop certain fields being changed by the user. However I don’t know what columns those fields will be in, only what value they will initially contain.

My current approach is this:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)    
    Dim columnHeaderRange As Range
Set shtData = Worksheets("Data")     
Set columnHeaderRange = Union(shtData.Columns(ColumnNumber(5, "example1")), _
                         shtData.Columns(ColumnNumber(5, "example2")), _
                         shtData.Columns(ColumnNumber(5, "example3")))    
Set columnHeaderRange = Application.Intersect(Target, columnHeaderRange)    
    ElseIf Not (columnHeaderRange Is Nothing) Then    
    With Application
        .EnableEvents = False
        .Undo
        MsgBox "Change is not possible.", 16
        .EnableEvents = True
    End With          
Else
    Exit Sub
End If

My ColumnNumber function in the above code takes the row and field value as parameters and returns the column number. Since I’m using fixed field values though, this fails if a field has been changed so my union call fails.

Is there a way to have this code run upon a user attempting to change the value of a cell but before the actual value of the cell is changed? Alternatively can anyone suggest a better approach?

How to&Answers:

Further to my comments

EXAMPLE 1

Create a sheet called List, which will store your values. The best part about this method is that you do not have to amend the code every time you want to add/delete items from your list.

See Screenshot

enter image description here

And let’s say this is your main sheet

enter image description here

Paste this code in the Sheet Code Area

Dim rngList As Range, aCell As Range
Dim RowAr() As Long

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long

    On Error GoTo Whoa

    Application.EnableEvents = False

    For Each aCell In Target
        If aCell.Row = 5 Then
            With Application
                For i = LBound(RowAr) To UBound(RowAr)
                    If RowAr(i) = aCell.Column Then
                        MsgBox "Change is not possible."
                        .Undo
                        GoTo Letscontinue
                    End If
                Next
            End With
        End If
    Next

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim wsList As Worksheet
    Dim n As Long, lrow As Long

    Set wsList = ThisWorkbook.Sheets("list")

    With wsList
        lrow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set rngList = .Range("A1:A" & lrow)
    End With

    n = 0
    ReDim RowAr(n)

    For Each aCell In Range("5:5")
        If Len(Trim(aCell.Value)) <> 0 Then
            If Application.WorksheetFunction.CountIf(rngList, aCell.Value) > 0 Then
                n = n + 1
                ReDim Preserve RowAr(n)
                RowAr(n) = aCell.Column
                Debug.Print aCell.Column
            End If
        End If
    Next
End Sub

enter image description here

Code in Action

enter image description here

EXAMPLE 2

This uses the hardcoded list.

Option Explicit

Dim RowAr() As Long, aCell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim MyList As String, MyAr() As String
    Dim n As Long, i As Long

    '~~> This is the list
    MyList = "Header 1,Header 2"
    MyAr = Split(MyList, ",")

    n = 0
    ReDim RowAr(n)

    For Each aCell In Range("5:5")
        If Len(Trim(aCell.Value)) <> 0 Then
            For i = LBound(MyAr) To UBound(MyAr)
                If aCell.Value = MyAr(i) Then
                    n = n + 1
                    ReDim Preserve RowAr(n)
                    RowAr(n) = aCell.Column
                End If
            Next
        End If
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long

    On Error GoTo Whoa

    Application.EnableEvents = False

    For Each aCell In Target
        If aCell.Row = 5 Then
            With Application
                For i = LBound(RowAr) To UBound(RowAr)
                    If RowAr(i) = aCell.Column Then
                        MsgBox "Change is not possible."
                        .Undo
                        GoTo Letscontinue
                    End If
                Next
            End With
        End If
    Next

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Answer:

If you dont want the formula’s visible to the users in cell they may not change you can also tick hidden.

VBA solution

You could have a 2 stage script:

  1. the first stage will save copies of your sheets in (hidden) sheets for reference AFTER a change is made to that sheet and also after stage 2. is run.

  2. Create a script for the Worksheet_Change(Target) that will check if the Target range originally contained one of the special values by looking up the row/column coordinates for all cells in the Target range in your worksheet copy. If it contained a special value you will just put that value back from your sheet copy. This is largely the script you already have…

Worksheet protection solution

Have you considered using worksheet protection (Review > Protect Sheet) and unlock the protection on only those cells the user is allowed to change? That way you will keep control of this without additional coding… Maybe there is some logic to where these cells are that you can already use upfront? Or after each change by your script you will run a VBA script to look up all cells with those values and set the locked property = True and then apply Worksheet protection again.

Manually set the protection lock of individual cells, or ranges by right clicking > format cells > protection > tick the box next to locked