How to protect range and share the workbook post protection

[ThrottleWorks]

Hi,

I am using below mentioned code to protect range.
However it is not working. Cells are not getting locked even after using this code.

Can anyone please help me in this.

Option Explicit
Sub MyProtect()
    'Code for protecting cells
    Dim CodeSht As Worksheet
  
    Dim TempLr As Long
    Set CodeSht = ActiveWorkbook.Worksheets("TAB")
    TempLr = CodeSht.Cells(CodeSht.Rows.Count, 1).End(xlUp).Row
  
    Dim TempRng As Range
    Set TempRng = CodeSht.Range(CodeSht.Cells(1, 7), CodeSht.Cells(TempLr, 10))
  
    On Error Resume Next
        ActiveWorkbook.ExclusiveAccess
        TempRng.Locked = True
        TempRng.Protect Password:="pass"
    On Error GoTo 0
End Sub

 

[vletm]

Have You checked
What would be 'TempLr' value?

 

[ThrottleWorks]

Hi @vletm sir, yes. I have checked. Do not know why it is not working.
This code is locking entire worksheet. I want lock only range.

 

[vletm]

What is value?
Any number or empty?

 

[ThrottleWorks]

Hi @vletm sir, TempLr = 9

? TempRng.Address
$G$1:$J$9

 

[vletm]

Good!
Next -
select that range from sheet by add tmp line
TempRng.Select
before
On Error Resume Next
and
check, that range can select!
= run Your code row-by-row

 

[ThrottleWorks]

Hi @vletm sir, done as advised. Code is able to select the range.
However code still not working.

 

[vletm]

... isn't worksheet protected before that?
... when do You unprotect that sheet?

 

[ThrottleWorks]

@vletm sir, I am only using the code mentioned above.

Option Explicit
Sub MyProtect()
    'Code for protecting cells
    Dim CodeSht As Worksheet
 
    Dim TempLr As Long
    Set CodeSht = ActiveWorkbook.Worksheets("TAB")
    TempLr = CodeSht.Cells(CodeSht.Rows.Count, 1).End(xlUp).Row
 
    Dim TempRng As Range
    Set TempRng = CodeSht.Range(CodeSht.Cells(1, 7), CodeSht.Cells(TempLr, 10))
 
    On Error Resume Next
        ActiveWorkbook.ExclusiveAccess
        TempRng.Locked = True
        TempRng.Protect Password:="pass"
    On Error GoTo 0
End Sub

 

[vletm]

is that sheet protected before using that code?

 

[ThrottleWorks]

No sir. Sheet is not protected.

 

[vletm]

... could You even think to upload that sheet here?

 

[vletm]

ThrottleWorks - okay..I still tested that Your 'code':
1) How did You check... noticed 'not working'?
2) TempRng.Protect Password:="pass" cannot work! after fix, it works!
3) why use ActiveWorkbook.ExclusiveAccess ? Shared file? Really need?
4) I made 'few' modifications and You would check this .. or not?

Sub MyProtect()
    On Error Resume Next
    With Sheets("TAB")
        If .ProtectContents Then Unprotect Password:="pass"
'   maybe next line no need ... who knows?
        If ActiveWorkbook.MultiUserEditing Then ActiveWorkbook.ExclusiveAccess
        .Range(.Cells(1, 7), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 10)).Locked = True
        Protect Password:="pass"
    End With
End Sub

 

[ThrottleWorks]

Hi @vletm thanks for the help. I am checking your code and will get back to you. Have a nice day ahead.

PS - I am not allowed to upload files. Apologies.

 

[ThrottleWorks]

Hi @vletm sir, sorry for late reply.

Checked your code, however, code is still locking entire worksheet.
I want lock specific range only. Could you please help if you get time.

Have a nice day ahead.

 

[ThrottleWorks]

Hi,

Please see attached file for more details.

 

[vletm]

ThrottleWorks
1) I did many questions ... no answers!
2) PS - I am not allowed to upload files. Apologies. - I see!
3) Checked your code, however, code is still locking entire worksheet.
NO, If ranges A2:F10 and K2:O10 are DEFAULT LOCKED then
what will happen during protection?
Answer is those ranges will LOCK too!
'My Code' works ONLY with that specific range!

 

[ThrottleWorks]

Hi @vletm sir, my apologies. Please give me some time to reply.