VBA to lock row based on column U value

[JohnLute]

Good day! I recently posted this and worked out some possible solutions however I'm still stuck so I'm posting it again.

I use column U as a "helper" in a table. The cells in this column have a formula that checks its row for errors. If it finds errors, it displays "OPEN"; if it finds no errors, it displays "LOCK".

On change event, I need to lock rows that display "LOCK" in the U helper column. Simply put: If target U = "LOCK" then lock entire row else do nothing.

Does anyone have anything that might help me with this?

 

[NoSparks]

What is the name of the table ?
What is the header for the helper column ?
Do you really need all 16,384 cells of the row locked or would just those in the table suffice ?

 

[JohnLute]

What is the name of the table ?
What is the header for the helper column ?
Do you really need all 16,384 cells of the row locked or would just those in the table suffice ?

Thanks for your reply.

The table name is tblOBLA.
The header for the helper column U is AUDHLPR.
The cells beyond the last column of the table (U) are already formatted as locked so I just need to lock columns A-N (columns O-U are all helper columns that are formatted as locked and are hidden).

 

[kvsrinivasamurthy]

TRy this code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim adr$, S$, T&
Dim M
    
    ActiveSheet.Unprotect Password:="abcd"
    Cells.Locked = False
    adr = ActiveSheet.ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Address
    M = Filter(Evaluate("transpose(If(" & adr & "=""LOCK"",""A""&Row(" & adr & "),false))"), False, False)
    
    For T = 0 To UBound(M)
    S = S & "," & M(T)
    If Len(S) > 240 Or T = UBound(M) Then
    Range(Mid(S, 2)).EntireRow.Locked = True
    End If
    Next T
    ActiveSheet.Protect Password:="abcd"

End Sub

Since you have not specified range for Change event it is not included in the code.

 

[kvsrinivasamurthy]

For protecting the sheet password used is "abcd". Change as required.

 

[kvsrinivasamurthy]

Modified Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim adr$, S$, T&
Dim M
    
    ActiveSheet.Unprotect Password:="abcd"
    Cells.Locked = False
    adr = ActiveSheet.ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Address
    M = Filter(Evaluate("transpose(If(" & adr & "=""LOCK"",""A""&Row(" & adr & "),false))"), False, False)
    
    For T = 0 To UBound(M)
    S = S & "," & M(T)
    If Len(S) > 240 Or T = UBound(M) Then
    Range(Mid(S, 2)).EntireRow.Locked = True
    S = ""
    End If
    Next T
    ActiveSheet.Protect Password:="abcd"

End Sub

 

[NoSparks]

Worksheet_Change isn't triggered by cells containing formulas you need to use Worksheet_Calculate.
And you need to know the displayed value of the cells you're interested in both before and after the sheet recalculating.

I neglected to ask the sheet name or the password to unprotect the sheet so you'll need to change what I've used to suit what you actually have.

Try this with a copy of your workbook

Insert a new module and declare a public variable

Public HelpArr

In the ThisWorkbook module

Private Sub Workbook_Open()
    HelpArr = Sheets("Sheet1").ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Value
End Sub

In the sheet module

Private Sub Worksheet_Activate()
    HelpArr = Sheets("Sheet1").ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Value
End Sub


Private Sub Worksheet_Calculate()
    Dim TempArr, i As Long

    TempArr = Sheets("Sheet1").ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Value
    For i = LBound(HelpArr) To UBound(HelpArr)
        If HelpArr(i, 1) <> TempArr(i, 1) Then
            If TempArr(i, 1) = "LOCK" Then
                With Sheets("Sheet1")
                    .Unprotect Password:=""
                    .ListObjects("tblOBLA").ListRows(i).Range.Cells(1).Resize(, 14).Locked = True
                    .Protect Password:=""
                    Exit For    ' stop checking at this point
                End With
            End If
        End If
    Next
    HelpArr = Sheets("Sheet1").ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Value
End Sub

You need to save, close and reopen the workbook for this to work.

 

[JohnLute]

Modified Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim adr$, S$, T&
Dim M
   
    ActiveSheet.Unprotect Password:="abcd"
    Cells.Locked = False
    adr = ActiveSheet.ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Address
    M = Filter(Evaluate("transpose(If(" & adr & "=""LOCK"",""A""&Row(" & adr & "),false))"), False, False)
   
    For T = 0 To UBound(M)
    S = S & "," & M(T)
    If Len(S) > 240 Or T = UBound(M) Then
    Range(Mid(S, 2)).EntireRow.Locked = True
    S = ""
    End If
    Next T
    ActiveSheet.Protect Password:="abcd"

End Sub

Thank you, kvsrinivasamurthy! I integrated this into my existing Change codes and tested. It's working very well! My only concern will be with performance. This is a new Excel file and it only has about 30 rows however it will expand to several thousand rows in short order. Do you see any issues running this on a table with thousands of rows?

 

[JohnLute]

Worksheet_Change isn't triggered by cells containing formulas you need to use Worksheet_Calculate.
And you need to know the displayed value of the cells you're interested in both before and after the sheet recalculating.

I neglected to ask the sheet name or the password to unprotect the sheet so you'll need to change what I've used to suit what you actually have.

Try this with a copy of your workbook

Insert a new module and declare a public variable

Public HelpArr

In the ThisWorkbook module

Private Sub Workbook_Open()
    HelpArr = Sheets("Sheet1").ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Value
End Sub

In the sheet module

Private Sub Worksheet_Activate()
    HelpArr = Sheets("Sheet1").ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Value
End Sub


Private Sub Worksheet_Calculate()
    Dim TempArr, i As Long

    TempArr = Sheets("Sheet1").ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Value
    For i = LBound(HelpArr) To UBound(HelpArr)
        If HelpArr(i, 1) <> TempArr(i, 1) Then
            If TempArr(i, 1) = "LOCK" Then
                With Sheets("Sheet1")
                    .Unprotect Password:=""
                    .ListObjects("tblOBLA").ListRows(i).Range.Cells(1).Resize(, 14).Locked = True
                    .Protect Password:=""
                    Exit For    ' stop checking at this point
                End With
            End If
        End If
    Next
    HelpArr = Sheets("Sheet1").ListObjects("tblOBLA").ListColumns("AUDHLPR").DataBodyRange.Value
End Sub

You need to save, close and reopen the workbook for this to work.

Thanks, NoSparks! I tried this and was unable to debug 2 issues. One was with line "For i = LBound(HelpArr) To UBound(HelpArr)". This threw Run-time error '9': Subscript out of range. I also experienced Run-time error '13': Type mismatch with another line but was unable to identify which line was throwing it. The code posted by kvsrinivasamurthy worked so I settled with that. I greatly appreciate your engagement in this. It helped me to see an alternate possibility I hadn't seen previously.

 

[JohnLute]

Worksheet_Change isn't triggered by cells containing formulas you need to use Worksheet_Calculate.
And you need to know the displayed value of the cells you're interested in both before and after the sheet recalculating.

This is true however the cells in column U are updated by changes made in the cells of a given row. When these changes are made then column U cells update accordingly.
I use 7 columns as helpers. They all contain formulas and are hidden. They check for data entry errors and provide values for conditional formatting. Column U is a culmination of all the other helper columns. If all the other helper columns display FALSE then column U displays "LOCK" otherwise, column U displays "OPEN". Every change made impacts what column U displays.