Improve Code

J

jynxy

New Member
Joined
Feb 13, 2022
Messages
32
Office Version
  1. 2019
Platform
  1. Windows
Hi,

is there anyway to improve the code below, i would need to duplicate this 365 times to make it work, im sure there would be a much simpler way to do this.

For Settings page check if yes/no to lock so Jan cells are O2 to O32 then Feb is Q2 to Q30 (inc 29th day) and so on

then on the Jan sheet, the Range is E6:E405 and is every 5 columns, so E,J,O,T,Y etc

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    'Sheets("Jan").Unprotect
    'Sheets("Feb").Unprotect
    'Sheets("Mar").Unprotect
    'Sheets("Apr").Unprotect
    'Sheets("May").Unprotect
    'Sheets("Jun").Unprotect
    'Sheets("Jul").Unprotect
    'Sheets("Aug").Unprotect
    'Sheets("Sep").Unprotect
    'Sheets("Oct").Unprotect
    'Sheets("Nov").Unprotect
    'Sheets("Dec").Unprotect
   
    Dim rCell As Range
   
    If Range("O2") = "No" Then
        For Each rCell In Worksheets("Jan").Range("E6:E405")
            rCell.Offset(0, 0).Locked = False
            rCell.Offset(0, 1).Locked = False
            rCell.Offset(0, -1).Locked = False
            rCell.Offset(0, -2).Locked = False
            rCell.Offset(0, -3).Locked = False
        Next rCell
    ElseIf Range("O2") = "Yes" Then
        For Each rCell In Worksheets("Jan").Range("E6:E405")
            If rCell.Offset(0, 0).Value = "Holiday" Or rCell.Offset(0, 0).Value = "Lieu" Or rCell.Offset(0, 0).Value = "Unpaid" Or rCell.Offset(0, 0).Value = "Float Day" Then
                rCell.Offset(0, 0).Locked = True
                rCell.Offset(0, 1).Locked = True
                rCell.Offset(0, -1).Locked = True
                rCell.Offset(0, -2).Locked = True
                rCell.Offset(0, -3).Locked = True
            End If
        Next rCell
    End If

    If Range("O3") = "No" Then
        For Each rCell In Worksheets("Jan").Range("J6:J405")
            rCell.Offset(0, 0).Locked = False
            rCell.Offset(0, 1).Locked = False
            rCell.Offset(0, -1).Locked = False
            rCell.Offset(0, -2).Locked = False
            rCell.Offset(0, -3).Locked = False
        Next rCell
    ElseIf Range("O3") = "Yes" Then
        For Each rCell In Worksheets("Jan").Range("J6:J405")
            If rCell.Offset(0, 0).Value = "Holiday" Or rCell.Offset(0, 0).Value = "Lieu" Or rCell.Offset(0, 0).Value = "Unpaid" Or rCell.Offset(0, 0).Value = "Float Day" Then
                rCell.Offset(0, 0).Locked = True
                rCell.Offset(0, 1).Locked = True
                rCell.Offset(0, -1).Locked = True
                rCell.Offset(0, -2).Locked = True
                rCell.Offset(0, -3).Locked = True
            End If
        Next rCell
    End If

    If Range("O4") = "No" Then
        For Each rCell In Worksheets("Jan").Range("O6:O405")
            rCell.Offset(0, 0).Locked = False
            rCell.Offset(0, 1).Locked = False
            rCell.Offset(0, -1).Locked = False
            rCell.Offset(0, -2).Locked = False
            rCell.Offset(0, -3).Locked = False
        Next rCell
    ElseIf Range("O4") = "Yes" Then
        For Each rCell In Worksheets("Jan").Range("O6:O405")
            If rCell.Offset(0, 0).Value = "Holiday" Or rCell.Offset(0, 0).Value = "Lieu" Or rCell.Offset(0, 0).Value = "Unpaid" Or rCell.Offset(0, 0).Value = "Float Day" Then
                rCell.Offset(0, 0).Locked = True
                rCell.Offset(0, 1).Locked = True
                rCell.Offset(0, -1).Locked = True
                rCell.Offset(0, -2).Locked = True
                rCell.Offset(0, -3).Locked = True
            End If
        Next rCell
    End If
   
    If Range("O5") = "No" Then
        For Each rCell In Worksheets("Jan").Range("T6:T405")
            rCell.Offset(0, 0).Locked = False
            rCell.Offset(0, 1).Locked = False
            rCell.Offset(0, -1).Locked = False
            rCell.Offset(0, -2).Locked = False
            rCell.Offset(0, -3).Locked = False
        Next rCell
    ElseIf Range("O5") = "Yes" Then
        For Each rCell In Worksheets("Jan").Range("T6:T405")
            If rCell.Offset(0, 0).Value = "Holiday" Or rCell.Offset(0, 0).Value = "Lieu" Or rCell.Offset(0, 0).Value = "Unpaid" Or rCell.Offset(0, 0).Value = "Float Day" Then
                rCell.Offset(0, 0).Locked = True
                rCell.Offset(0, 1).Locked = True
                rCell.Offset(0, -1).Locked = True
                rCell.Offset(0, -2).Locked = True
                rCell.Offset(0, -3).Locked = True
            End If
        Next rCell
    End If
    'Sheets("Jan").Protect
    'Sheets("Feb").Protect
    'Sheets("Mar").Protect
    'Sheets("Apr").Protect
    'Sheets("May").Protect
    'Sheets("Jun").Protect
    'Sheets("Jul").Protect
    'Sheets("Aug").Protect
    'Sheets("Sep").Protect
    'Sheets("Oct").Protect
    'Sheets("Nov").Protect
    'Sheets("Dec").Protect
End Sub
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
Untested, but something like:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    'Sheets("Jan").Unprotect
    'Sheets("Feb").Unprotect
    'Sheets("Mar").Unprotect
    'Sheets("Apr").Unprotect
    'Sheets("May").Unprotect
    'Sheets("Jun").Unprotect
    'Sheets("Jul").Unprotect
    'Sheets("Aug").Unprotect
    'Sheets("Sep").Unprotect
    'Sheets("Oct").Unprotect
    'Sheets("Nov").Unprotect
    'Sheets("Dec").Unprotect
   
   Dim counter As Long
   counter = 0
Dim cell as range
   For each cell in Range("O2:O32").Cells
      ToggleCellLocks cell.Value, Worksheets("Jan").Range("E6:E405").Offset(, counter * 5)
      counter = counter + 1
   Next cell
    
    'Sheets("Jan").Protect
    'Sheets("Feb").Protect
    'Sheets("Mar").Protect
    'Sheets("Apr").Protect
    'Sheets("May").Protect
    'Sheets("Jun").Protect
    'Sheets("Jul").Protect
    'Sheets("Aug").Protect
    'Sheets("Sep").Protect
    'Sheets("Oct").Protect
    'Sheets("Nov").Protect
    'Sheets("Dec").Protect
End Sub
Sub ToggleCellLocks(LockState As String, LockRange As Range)
    Select Case UCase$(LockState)
      Case "NO"
        LockRange.Offset(, -3).Resize(, 5).Locked = False
      Case "YES"
         Dim cell As Range
        For Each cell In LockRange.Cells
            Select Case UCase$(cell.Value)
               Case "HOLIDAY", "LIEU", "UNPAID", "FLOAT DAY"
                cell.Offset(0, -3).Resize(, 5).Locked = True
            End Select
        Next cell
    End Select
End Sub

If repeating for more sheets, make sure to reset the counter to 0 at the start of each month's processing.
 
Upvote 0
Solution
Thanks @RoryA on a quick test this seems to be working,

i tried to add the following after the first but guessing i am miss understanding how the code works.

VBA Code: 
counter = 0
    For Each cell In Range("Q2:Q30").Cells
        ToggleCellLocks cell.Value, Worksheets("Feb").Range("E6:E405").Offset(, counter * 5)
        counter = counter + 1
    Next cell
 
Upvote 0
That would be correct assuming the same pattern on the Feb sheet.
 
Upvote 0
i did that and received the following error ?

Runtime Error 1004 - Unable to set the locked property of the range class, do i need to change to cell2 and counter2 ?

VBA Code: 
Dim counter As Long
    Dim cell As Range
    
    counter = 0
    For Each cell In Range("O2:O32").Cells
        ToggleCellLocks cell.Value, Worksheets("Jan").Range("E6:E405").Offset(, counter * 5)
        counter = counter + 1
    Next cell
    
    counter = 0
    For Each cell In Range("Q2:Q30").Cells
        ToggleCellLocks cell.Value, Worksheets("Feb").Range("E6:E405").Offset(, counter * 5)
        counter = counter + 1
    Next cell
 
Upvote 0
Did you unprotect the sheet?
 
Upvote 0
The sheet is not protected, that has been commented out and also double checked.
 
Upvote 0
I can’t see how you would get that error if the sheet is not protected.
 
Upvote 0
You must log in or register to reply here.

Similar threads

drom
  • Solved
Pictures.Insert(wURL) does not work with some images
Replies
2
Views
252
drom
drom
S
  • Question
VBA Macro to add Header arrays and insert 2 rows
2
Replies
14
Views
767
slohman
S
F
  • Question
Returning changed dynamically created textbox value to corresponding cell
Replies
2
Views
342
frateg8r
F
J
  • Solved
VBA lock cells to data entry after approval
Replies
4
Views
635
GWteB
GWteB
A
  • Question
After User Enters A Value (Validation List), Not Automatically Advancing To Next Cell As Per "Select"
Replies
1
Views
181
Ark68
A

Forum statistics

Threads
1,215,072
Messages
6,122,968
Members
449,095
Latest member
Mr Hughes

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top