VBA code in excel [Solved/Closed]

Report
-
 issa -
Dears who can help me to write VBA code to solve the following case:

I have Excel sheet to calculate overtime, includes several rows for each month, and the sheet is protected but allowing the user to enter data into some specified range (P11:P20,R11:X20) (Allow user to edit range).

Also, the Range (R11:R20) are rows with drop list menu of 4 values (1,2,3,4).

My case: For example, if the user selected either value 3 or 4 ONLY in cell (R15) I need to block or protect the range (T15:U15), and if then with the same sheet selected 3 or 4 value in cell R19 to protect the range (T19:U19) and so on.

Therefore I need if some value selected in specific cell to protect some ranges within the same row. Please note that the user may select one selection or multi selection in the same sheet.

I hope it's clear and you can find solution.
Thank you in advance for any kind of assistance and best regards,
Issa

1 reply

Posts
2693
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 18, 2021
455
Hi Issa,

For the following code to work, you need to make some changes to your sheet.

Delete the "Allow user to edit range".

Now select the ranges you want users to be able to adjust (P11:P20,R11:X20).
Right-click, cell properties, protection tab and uncheck protection.
Goto topmenu, extra, protection, protect sheet.

Now you basicly got what you already had.

Now right-click the sheets tab and select view code.
Paste the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cRow As Integer
If Intersect(Target, Range("R11:R20")) Is Nothing Then Exit Sub

If Target.Value = 3 Or Target.Value = 4 Then
ActiveSheet.Unprotect
cRow = Target.Row
Range(Cells(cRow, "T"), Cells(cRow, "U")).Locked = True
ActiveSheet.Protect
End If

If Target.Value = 1 Or Target.Value = 2 Then
ActiveSheet.Unprotect
cRow = Target.Row
Range(Cells(cRow, "T"), Cells(cRow, "U")).Locked = False
ActiveSheet.Protect
End If

End Sub

Now test the result by changing the value of range R11:R20 from 1 or 2 to 3 or 4 and back.

Will this work for you?

Best regards,
Trowa
Dear Trowa,
Thanks a lot, I appreciate all your assistance.
It workes excellent, great :)

Thank you again.

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!