none
Need VBA Code for Protecting cell range based on another cell range value RRS feed

  • Question

  • I want to apply code for below function/logic:

    if Cell A1 = "1" then Cell B1 = locked and empty, Cell C1 = unlocked and allowed to select value from drop down list, cell D1 = locked and empty
    if Cell A1 = "2" then Cell B1 = unlocked and allowed to select value from drop down list, Cell C1 = locked and empty, Cell D1 = unlocked and allowed to select value from drop down list
    if Cell A1 = "3" then Cell B1 & C1 & D1 = unlocked and allowed to select value from drop down list
    If Cell A1 = "" then Cell B1 & C1 & D1 = locked and empty

    if Cell A2 = "1" then Cell B2 = locked and empty, Cell C2 = unlocked and allowed to select value from drop down list, cell D2 = locked and empty
    if Cell A2 = "2" then Cell B2 = unlocked and allowed to select value from drop down list, Cell C2 = locked and empty, Cell D2 = unlocked and allowed to select value from drop down list
    if Cell A2 = "3" then Cell B2 & C2& D2 = unlocked and allowed to select value from drop down list
    If Cell A2 = "" then Cell B2 & C2 & D2 = locked and empty

    I want to apply this function / logic in A1 to A2000 relatively

    I hope its clear & sufficient to get answered

    Please revert asap

    thanks in advance
    Tuesday, July 19, 2016 2:14 PM

Answers

  • The following will only work if column A is unlocked, and if the user edits the value of A1, A2 etc. directly.

    Right-click the sheet tab and select View Code from the context menu.

    Copy the following code into the worksheet module:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        If Not Intersect(Range("A1:A2000"), Target) Is Nothing Then
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            Me.Unprotect 'Password:="secret"
            For Each cel In Intersect(Range("A1:A2000"), Target)
                Select Case cel.Value
                    Case ""
                        With cel.Offset(0, 1).Resize(1, 3)
                            .ClearContents
                            .Locked = True
                        End With
                    Case 1
                        With cel.Offset(0, 1)
                            .ClearContents
                            .Locked = True
                        End With
                        With cel.Offset(0, 2)
                            .Locked = False
                        End With
                        With cel.Offset(0, 3)
                            .ClearContents
                            .Locked = True
                        End With
                    Case 2
                        With cel.Offset(0, 1)
                            .Locked = False
                        End With
                        With cel.Offset(0, 2)
                            .ClearContents
                            .Locked = True
                        End With
                        With cel.Offset(0, 3)
                            .ClearContents
                            .Locked = False
                        End With
                    Case 3
                        With cel.Offset(0, 1).Resize(1, 3)
                            .Locked = False
                        End With
                End Select
            Next cel
            Me.Protect 'Password:="secret"
            Application.EnableEvents = True
            Application.ScreenUpdating = True
        End If
    End Sub

    Make sure that you save the workbook as a macro-enabled workbook (.xlsm), and that you allow macros when you open the workbook.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Tuesday, July 19, 2016 3:02 PM