Dynamically lock cells - conditional formatting

[Tebrica]

Hi Everyone,

I'm trying to find solution to dynamically lock cells in specified range, that would depend on the cell color, which would be driven by conditional formatting formulas.
In the attached file, the intent is to place $ amounts in columns "Land", "Sea", "Ocean", etc., however when the user insert amounts in "Land" column, it shouldn't allow input in "Sea" or "Ocean" column - they are going to become light grey. When user insert "Sea" amounts, it should forbid input in "Land" column, but allow "Ocean" inputs. Same is valid if the user first insert amounts in "Ocean" column (allow "Sea" but forbid "Land").

For exercise, I've placed VBA just for "Sea" column, which gives me error '1004' Unable to set the Locked property of the Range class.
I guess there can be multiple ways of doing this, but my vote goes to color rule (242, 242, 242), as I can have multiple combinations in multiple columns going forward, but this color is going to be strict rule to rely on.

Also, not sure how to share the xlsm file here, although I think it could be more helpful than screenshots that are added.

Any help is welcomed.

Tebrica

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter a value in any column H:J and press the RETURN key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("H:J")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect
    Select Case Target.Column
        Case Is = 8
            Range("I" & Target.Row).Resize(, 2).Locked = True
        Case Is = 9
            Range("H" & Target.Row).Locked = True
            Range("J" & Target.Row).Locked = True
        Case Is = 10
            Range("H" & Target.Row).Resize(, 2).Locked = True
    End Select
    ActiveSheet.Protect
    ActiveSheet.EnableSelection = xlUnlockedCells
    Application.ScreenUpdating = False
End Sub

 

[Tebrica]

Thanks. It would work, except for the case I change my mind and delete the value (in Land column), then I'd like to go back to start and allow again all 3 columns to be filled in. It doesn't allow to re-fill the data.

Tebrica

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("H:J")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect
    Select Case Target.Column
        Case Is = 8
            Range("I" & Target.Row).Resize(, 2).Locked = True
        Case Is = 9
            Range("H" & Target.Row).Locked = True
            Range("J" & Target.Row).Locked = True
        Case Is = 10
            If Target = "" Then
                Range("H" & Target.Row).Resize(, 2).Locked = False
            Else
                Range("H" & Target.Row).Resize(, 2).Locked = True
            End If
    End Select
    ActiveSheet.Protect
    ActiveSheet.EnableSelection = xlUnlockedCells
    Application.ScreenUpdating = False
End Sub

 

[Tebrica]

Hi Mumps, now it locks all of the cells and I'm not able to select any of it on the worksheet.

 

[mumps]

All the cells an Excel sheet are locked by default so when the sheet is protected, you will not be able to access any cell. Unprotect the sheet and unlock all the cells in the sheet and try the macro again.

 

[Tebrica]

All the cells an Excel sheet are locked by default so when the sheet is protected, you will not be able to access any cell. Unprotect the sheet and unlock all the cells in the sheet and try the macro again.

It's the same issue. when insert value in H5 cell, it properly locks I5 and J5. However, when I delete value from H5 it doesn't allow input of values in I5 and J5, but it should (back to default, or initial point).

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("H:J")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect
    Select Case Target.Column
        Case Is = 8
            If Target = "" Then
                Range("I" & Target.Row).Resize(, 2).Locked = False
            Else
                Range("I" & Target.Row).Resize(, 2).Locked = True
            End If
        Case Is = 9
            If Target = "" Then
                Range("H" & Target.Row).Locked = False
                Range("J" & Target.Row).Locked = False
            Else
                Range("H" & Target.Row).Locked = True
                Range("J" & Target.Row).Locked = True
            End If
        Case Is = 10
            If Target = "" Then
                Range("H" & Target.Row).Resize(, 2).Locked = False
            Else
                Range("H" & Target.Row).Resize(, 2).Locked = True
            End If
    End Select
    ActiveSheet.Protect
    ActiveSheet.EnableSelection = xlUnlockedCells
    Application.ScreenUpdating = False
End Sub

 

[Tebrica]

Thanks mumps, that works perfect.

 

[mumps]

You are very welcome.