excelvbacell-formatting

Unlock the next cell when previous cell is filled


Situation I have an excel form and I want to ensure that the user go in a sequence where the next cell will be unlocked only if initial cells are filled up. My excel sheet also has some checkboxes as well as cell merged together.

current solution I am using for example following code:-

If Range("V12").Value > 3 Or Range("V12").Value < 3 Then
    Me.Unprotect
    Range("E13:G17").Value = ""
     Range("E13:G17").Interior.Color = RGB(226, 239, 218)
    Range("E13:G17").Locked = True
    Me.Protect
Else
    Me.Unprotect
    Range("E13:G17").Locked = False
    Range("E13:G17").Interior.Color = RGB(255, 255, 255)
    Me.Protect

but the problem is, I have multiple ranges and I have to write a repeated formula for the remaining ranges.

My requirement Is this the optimal code or I can still improve my code? and I want user to jump only in the green field.

Please find the file through this link:- Link to the excel file,please click here


Solution

  • You have a lot of repeated code which could be reduced significantly if you factor out the Protect/Unprotect into a separate Sub.

    Eg:

    Private Sub Worksheet_Change(ByVal Target As Range)
    
        '...
        '...
        ProtectRange Me.Range("E13:G17"), (Me.Range("V12").Value > 3 Or _
                                           Me.Range("V12").Value < 3)
        
        ProtectRange Me.Range("L13:N17"), (Me.Range("V14").Value > 4 Or _
                                           Me.Range("V14").Value < 4)
        '...
        '...
    
    End Sub
    
    'Protect/unprotect range `rng` based on boolean `DoLock` (defaults to True)
    Sub ProtectRange(rng As Range, Optional DoLock As Boolean = True)
        Me.Unprotect
        If DoLock Then 
            Application.EnableEvents = False 'don't re-trigger event handler...
            rng.ClearContents
            Application.EnableEvents = True
        End If
        rng.Interior.Color = IIf(DoLock, RGB(226, 239, 218), RGB(255, 255, 255))
        rng.Locked = DoLock
        Me.Protect
    End Sub
    

    Would also improve your code to check for a change in (eg) V12 before calling the lock/unlock sub, rather than processing every range regardless of where the Change event was triggered.

    EDIT - another approach which should be faster when executing -

    Option Explicit
    
    Dim colLock As Collection    'any ranges to be locked
    Dim colUnlock As Collection  'any ranges to be unlocked
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rng As Range
        
        Set colLock = New Collection    'reset collections
        Set colUnlock = New Collection
    
        'Test each section in turn and decide if to lock/unlock...
    
        CheckRange Me.Range("V12"), Target, Me.Range("E13:G17"), _
                  (Me.Range("V12").Value > 3 Or Me.Range("V12").Value < 3)
        
        CheckRange Me.Range("V14"), Target, Me.Range("L13:N17"), _
                  (Me.Range("V14").Value > 4 Or Me.Range("V14").Value < 4)
        
        
        'check more ranges.....
        
        'Done testing: anything to lock/unlock ?
        If colLock.Count > 0 Or colUnlock.Count > 0 Then
            Me.Unprotect
            Application.EnableEvents = False
            
            'loop over any collected ranges
            For Each rng In colLock
                rng.ClearContents
                rng.Interior.Color = RGB(226, 239, 218)
                rng.Locked = True
            Next rng
            For Each rng In colUnlock
                rng.Interior.Color = RGB(255, 255, 255)
                rng.Locked = False
            Next rng
            
            Application.EnableEvents = True
            Me.Protect
        End If
    End Sub
    
    'Check if `Target` includes `rngTrigger`, and if it does then collect `rngLock` in
    '  either `ColLock` or `colUnlock` depending on the test result in `doLock`
    Sub CheckRange(rngTrigger As Range, Target As Range, rngLock As Range, doLock As Boolean)
        If Not Application.Intersect(rngTrigger, Target) Is Nothing Then
            If doLock Then
                Debug.Print "Locking " & rngLock.Address()
                colLock.Add rngLock
            Else
                Debug.Print "Unlocking " & rngLock.Address()
                colUnlock.Add rngLock
            End If
        End If
    End Sub