VBA to disable Cells

[dhen21dx]

Hello,

Please help me, i need to disable editing of cells, sample range A2:A5000 value "TRUE", i need to disable the range F2:F2000 to J2:2000. and mandatory to input for B2:B2000-E2:E2000.

Thanks in advance

 

[Yongle]

Is this what you want?
IF A3 = TRUE THEN lock F3,G3,H3 & J3 AND force user to enter values in B3,C3,D3 &E3

How should user be forced to enter the values?
- prevent user from leaving row 3 unless values input into B3:E3?
- prevent file being closed unless all manatory values are input?

 

[dhen21dx]

Example: A2 = TRUE, lock F2,G2,H3 and J2, then mandatory field for for B2,C2,D2 and E3 when closing the workbook error will pop up and tell the mandatory fields.

Thanks

 

[Yongle]

Below should provide most of what you need
Worksheet_Change triggers protection in Target row when value in column A is amended - is this the correct trigger for you?
How_to_call_the_sub applies rule to the whole range

To test the code
You are only required to place the code in the correct modules and amend the values in red

In Sheet1 SHEET module (does not work if placed anywhere else)

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Row = 1 Then Exit Sub
        If .Column = 1 Then Call ApplyRule(Target)
    End With
End Sub

In STANDARD module

Option Explicit

Public Const MyRange = "A2:A5000"
Public Const MySheet = "[COLOR=#ff0000]Sheet1[/COLOR]"                 '[COLOR=#ff0000][I]amend to corrrect sheet name[/I][/COLOR]
Public Const SheetPassword = "[COLOR=#ff0000]password[/COLOR]"         '[COLOR=#ff0000][I]amend to your password[/I][/COLOR]

Sub How_to_call_the_sub()
    Call ApplyRule(Sheets(MySheet).Range(MyRange))
End Sub

Sub ApplyRule(aRange As Range)
    Dim Cell As Range, ws As Worksheet
    Set ws = aRange.Parent
    ws.Unprotect SheetPassword
    aRange.EntireRow.Locked = False
    For Each Cell In aRange
        If Cell = True Then Cell.Offset(, 5).Resize(, 5).Locked = True
    Next Cell
    ws.Protect SheetPassword
End Sub

Function MandatoryCells() As Boolean
    Dim Rng As Range, Cell As Range
    For Each Cell In Sheets(MySheet).Range(MyRange)
        If Cell Then
            If WorksheetFunction.CountBlank(Cell.Offset(, 1).Resize(, 4)) > 0 Then
                MandatoryCells = False
                Exit Function
            End If
        End If
    Next Cell
    
    MandatoryCells = True
    
End Function

In ThisWorkbook module (does not work if placed anywhere else)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Not MandatoryCells Then
        MsgBox "Request to close denied - mandatory cells not completed", vbCritical, "Cannot close"
        Cancel = True
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
        If Not MandatoryCells Then MsgBox "Some mandatory cells incomplete", vbInformation, "Workbook saved"
End Sub

Why A2:A5000 ?
- should the code simply look at range A2 to last row with value in column A?
- let me know

 

[dhen21dx]

Yes, should be A2 to last row, however i only knew the coding for range and set to your limit. Thank you so much, and i will study this so i can gain more knowledge and logic behind

 

[Yongle]

Yes, should be A2 to last row

What I gave you should not cause any problems during testing.
After testing, let me know if anything else needs changing and I will amend code to use last row at the same time.

 

[dhen21dx]

Hi Yongle,

Yes it seems no errors, however, i have validation list also True or false on the column H, and got an error. It seems that the code design to look for True value? How about if i need more like "True" and "Move", can it be set at the same time?. Please advise

ExAlphabet is the Column, D= Disabled editing, on H Validationlist of True or False.)

[TABLE="width: 640"]
<colgroup><col width="64" span="10" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]HeaderA[/TD]
[TD="width: 64"]HeaderB[/TD]
[TD="width: 64"]HeaderC[/TD]
[TD="width: 64"]HeaderD[/TD]
[TD="width: 64"]HeaderE[/TD]
[TD="width: 64"]HeaderF[/TD]
[TD="width: 64"]HeaderG[/TD]
[TD="width: 64"]HeaderH[/TD]
[TD="width: 64"]HeaderI[/TD]
[TD="width: 64"]HeaderJ[/TD]
[/TR]
[TR]
[TD]True[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]D[/TD]
[TD]D[/TD]
[TD]D[/TD]
[TD]D[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]Move[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]D[/TD]
[TD]D[/TD]
[TD]D[/TD]
[TD]D[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]False[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]True[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Yongle]

Today - holiday. Will reply tomorrow