Lock Entire Row based on cell specific text

Louis12 · Aug 7, 2014

Hi,

I have a excel sheet named "Download", in this sheet i have column A to Z containing data and from row 2 to row 2000.

In column V i have the following text "01.01.2014 - PMT".

1. I need some code to check if each cell in column V contains the letters PMT and if it finds it it must lock the entire row from editing, if it does not find the word PMT in column V it must ignore the and move to the next row until done. This part is when the Worksheet is opened.

2. When I change a cell in column V to contain the letters PMT and then press enter it must automaticaly lock the entire row.

I have looked at all the code related to Lock Cell/Row on this forum and can't find something that fits the need.

Thank You for all your help.

sijpie · Aug 8, 2014

OK, first of all, if your row is locked after a change in V, then there is no reason to redo the check on opening the workbook. All the rows are locked.

So I have written two macros:

The first macro is entered in the module for the sheet that contains this column V (if it needs to be done for more sheets, just copy it to each).
The 2nd macro runs through the whole column V and locks each row with PMT. This is so that you can lock the rows at the start, or after a multi-cell copy. The macro needs to be in a standard module. It can then be activated through Alt-F8

Go to the sheet and right click on the name tab.
Select View Code...
The macro editor opens in the Sheet Module. This is where 'events' for this sheet can be monitored and acted on.
Paste the following macro there:

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns("V")) Is Nothing Then ' the changed cell is in column V If Target.Cells.Count = 1 Then ' only act if it is a single cell, so multicell copy will not trigger this If InStr(1, Target.Value, "PMT") Then Target.EntireRow.Locked = True End If End If End If End Sub

In the window to the left where you have pasted the macro, you see the workbook and its sheets. Right click on the the 'ThisWorkbook' and select Insert / Module
This time a standard macro module opens. Here you can paste the following macro:

Option Explicit Sub LockPMT() ' Lock those rows where Column V contains "PMT" Dim rChk As Range, r1st As Range Set r1st = Columns("V").Find(What:="PMT", _ after:=Cells(Rows.Count, "V"), _ LookIn:=xlValues, lookat:=xlPart, _ searchdirection:=xlNext) If Not r1st Is Nothing Then ' PMT is found Set rChk = r1st Do rChk.EntireRow.Locked = True Set rChk = Columns("V").FindNext(after:=rChk) Loop While rChk.Address <> r1st.Address ' else endless loop End If Set r1st = Nothing Set rChk = Nothing End Sub

OK, now go back to the spreadsheet.
type something in column V. If it contains PMT the row will be instantly locked.
Now press Alt-F8 rin the macro and now all the rows with PMT are locked. Save the workbook (in Excel 2007+ save as xlsm, macro enabled)

Louis12 · Aug 8, 2014

Hi, Thank you for the code but I think there is something wrong as it does not lock the rows as I am able to delete/modify the data in each cell from Column A to V once i have pressed ALT-F8.

Also I am able to delete/modify existing data that contains in Column "V" ****PMT

if I protect the Worksheet or Workbook I then get a error on:
Macro 1 = Target.EntireRow.Locked = True
Macro 2 = rChk.EntireRow.Locked = True

sijpie · Aug 8, 2014

Ah, yes, small oversight on my behalf.

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns("V")) Is Nothing Then ' the changed cell is in column V If Target.Cells.Count = 1 Then ' only act if it is a single cell, so multicell copy will not trigger this If InStr(1, Target.Value, "PMT") Then Me.Unprotect Password:="" Target.EntireRow.Locked = True Me.Protect Password:="" End If End If End If End Sub

Sub LockPMT() ' Lock those rows where Column V contains "PMT" Dim rChk As Range, r1st As Range Set r1st = Columns("V").Find(What:="PMT", _ after:=Cells(Rows.Count, "V"), _ LookIn:=xlValues, lookat:=xlPart, _ searchdirection:=xlNext) If Not r1st Is Nothing Then ' PMT is found Set rChk = r1st Do ActiveSheet.Unprotect Password:="" rChk.EntireRow.Locked = True ActiveSheet.Protect Password:="" Set rChk = Columns("V").FindNext(after:=rChk) Loop While rChk.Address <> r1st.Address ' else endless loop End If Set r1st = Nothing Set rChk = Nothing End Sub 

If you lock with a password, supply it in the code

joleneng15 · Apr 5, 2016

Hi,

I have a similar problem ,

My value that will be changing is link to another spreadsheet = 1- reject , 2- In progress 3-

I'm trying to have it lock when value contains "1-"

Appreciate the experts advice.

joleneng15 · Apr 5, 2016

and to unlock if cell contain value not "1-"

sijpie · Apr 6, 2016

Go to the sheet where you want this to happen and right click on the name tab.
Select View Code...
The macro editor opens in the Sheet Module. This is where 'events' for this sheet can be monitored and acted on.
Paste the following macro there:

Code:

Option explicit 

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Columns("V")) Is Nothing Then
        ' the changed cell is in column V. Modify the "V" to whatever your column is where the "1-" comes in
        If Target.Cells.Count = 1 Then
            ' only act if it is a single cell, so multicell copy will not trigger this
            If InStr(1, Target.Value, "1-") Then
                Me.Unprotect Password:=""
                Target.EntireRow.Locked = True
                Me.Protect Password:=""
            Else            
                Me.Unprotect Password:=""
                Target.EntireRow.Locked = False
                Me.Protect Password:=""
            End If

        End If
    End If
End Sub

Lock Entire Row based on cell specific text

Louis12

New Member

Excel Facts

sijpie

Well-known Member

Louis12

New Member

sijpie

Well-known Member

joleneng15

New Member

joleneng15

New Member

sijpie

Well-known Member

Similar threads

Forum statistics

Share this page

Lock Entire Row based on cell specific text

Louis12

New Member

Excel Facts

sijpie

Well-known Member

Louis12

New Member

sijpie

Well-known Member

joleneng15

New Member

joleneng15

New Member

sijpie

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock