Lock Cells with certain texts

[DonPaolo]

Hi All!

New here! Been reading this forum for some very helpful tips and solutions but 1st time to register as I cant seem to find a solution to what I need to do.

Could you give me a marco command to lock cells that contains specific texts (e.g. cells containing "new report", or "Completed", or "End")

Thank you in advance!

 

[mumps]

Can the texts be anywhere in the sheet or are they in a specific column or row? Also, is one of the values "new report" or "New Report"?

 

[mumps]

Start by unlocking all the cells in your sheet and protect the sheet with a password of your choosing. Change "myPassword" in the code to match your password (2 occurrences). This macro assumes that the values can be anywhere on your sheet. If they are in a particular column, please let me know and I will modify the macro although the macro below will work in both cases.

Option Compare Text
Sub CopyRange()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="myPassword"
    Dim myArray As Variant
    Dim foundVal As Range
    Dim i As Long
    Dim sAddr As String
    myArray = Array("new report", "Completed", "End")
    For i = LBound(myArray) To UBound(myArray)
        Set foundVal = ActiveSheet.UsedRange.Find(myArray(i), LookIn:=xlValues, lookat:=xlWhole)
        If Not foundVal Is Nothing Then
            sAddr = foundVal.Address
            Do
                foundVal.Locked = True
                Set foundVal = ActiveSheet.UsedRange.FindNext(foundVal)
            Loop While foundVal.Address <> sAddr
        End If
        sAddr = ""
    Next i
    ActiveSheet.Protect Password:="myPassword"
    ActiveSheet.EnableSelection = xlUnlockedCells
    Application.ScreenUpdating = True
End Sub

 

[DonPaolo]

Can the texts be anywhere in the sheet or are they in a specific column or row? Also, is one of the values "new report" or "New Report"?

Hi Mumps, its anywhere in the sheet. In one of the values, meant to say "New Report"

 

[mumps]

OK. Try this macro:

Sub CopyRange()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="myPassword"
    Dim myArray As Variant
    Dim foundVal As Range
    Dim i As Long
    Dim sAddr As String
    myArray = Array("New Report", "Completed", "End")
    For i = LBound(myArray) To UBound(myArray)
        Set foundVal = ActiveSheet.UsedRange.Find(myArray(i), LookIn:=xlValues, lookat:=xlWhole)
        If Not foundVal Is Nothing Then
            sAddr = foundVal.Address
            Do
                foundVal.Locked = True
                Set foundVal = ActiveSheet.UsedRange.FindNext(foundVal)
            Loop While foundVal.Address <> sAddr
        End If
        sAddr = ""
    Next i
    ActiveSheet.Protect Password:="myPassword"
    ActiveSheet.EnableSelection = xlUnlockedCells
    Application.ScreenUpdating = True
End Sub

Please refer to Post #3 for some instructions.

 

[DonPaolo]

Worked like magic!! Thank you very much!

 

[mumps]

You are very welcome.