CODEWITHSUNDEEP
excelvba
Adrian
Adrian

Reputation: 907

how to block users from modyfing more than 2 cell values in specific range of cells

I have a form that is automatically filled when user chooses job position, however in 3 sections I have drop-down lists (B21:B45, B27:B30, B50:B67) and users will be allowed to change max 2 options from these drop-down lists.

In other words I have a table B21:C45 and if user will modify 2 out of 25 cells in column B then macro will automatically give a message that you've modified the maximum number of cells and then macro will lock cells B21:B45. The same applies to other 2 tables (so for RngTwo and RngThree).

I've tried to use Intersect function but I am not sure how to write a macro that would lock specific range of cells if 2 cells in this range are changed. The biggest challenge for me is that macro needs to take into condsideration all 3 ranges.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RngOne As Range
    Dim RngTwo As Range
    Dim RngThree As Range

    Set RngOne = Range("B21:B45")
    Set RngTwo = Range("B27:B30")
    Set RngThree = Range("B50:B67")

    If Not Application.Intersect(RngOne, Range(Target.Address)) Is Nothing Then
        MsgBox "You changed " & Target.Count & " out of " & RngOne.Count & " cells."
    End If
End Sub

Upvotes: 0

Views: 76

Answers (2)

Viktor West
Viktor West

Reputation: 574

My solution is that there are two subs working together. The startSelection is storing the status of the ranges into the arrays. It shall be triggered before let the user starting changes. Then the Worksheet_Change compare the values and calculate how many cells has been changed. Calling the startSelection can be re-initiated the process. I have not finalized the sub for all the ranges so it shall be finished if this solution is considered good.

Dim RngOne As Range ' Global variables
Dim RngTwo As Range
Dim RngThree As Range
Dim vOne As Variant
Dim vTwo As Variant
Dim vThree As Variant

Sub startSelection()
    Set RngOne = Range("B21:B45")
    Set RngTwo = Range("B27:B30")
    Set RngThree = Range("B50:B67")
    vOne = RngOne.value
    vTwo = RngTwo.value
    vThree = RngThree.value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If RngOne Is Nothing Then Call startSelection
    If Intersect(Target, Union(RngOne, RngTwo, RngThree)) Is Nothing Then
        Exit Sub
    End If
    Dim i As Integer
    Dim rng As Range
    Dim iChanged As Integer
    iChanged = 0
    For Each rng In RngOne
        i = i + 1
        If vOne(i, 1) <> rng.value Then iChanged = iChanged + 1
    Next rng
    'should be repeated for the other two ranges
    If iChanged > 2 Then
        MsgBox "You changed " & iChanged & " out of " & RngOne.Count & " cells."
    End If
End Sub

Upvotes: 1

Variatus
Variatus

Reputation: 14373

You may like to try this code.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 048

    Static Count(1 To 3)    As Integer
    Dim Rng                 As Range
    Dim i                   As Integer          ' array index

    If Target.CountLarge > 1 Then Exit Sub
    Set Rng = Application.Union(Range("B21:B25"), Range("B27:B30"), Range("B50:B67"))
    For i = 1 To 3
        If Not Application.Intersect(Rng.Areas(i), Target) Is Nothing Then
            If Count(i) < 2 Then
                Count(i) = Count(i) + 1
            Else
                MsgBox "You have exceeded the maximum number (2)" & vbCr & _
                       "of permissible changes in this section." & vbCr & _
                       "This change will be rolled back.", _
                       vbInformation, "Too many changes"
                With Application
                    .EnableEvents = False
                    .Undo
                    .EnableEvents = True
                End With
            End If
            Exit For
        End If
    Next i
End Sub

The three ranges you set are overlapping, and that would require more precise coding once you specify what you really mean. For the moment I have just presumed that there is a type in one of the addresses and set the first range as B21:B25 instead of B21:B45.

Anyway, this is only to show the approach. The solution is only perfunctorily tested. Should errors occur when you test please let me know and I shall fix them.

Upvotes: 3

Related Questions