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

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
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

O
  • Question Question
Frustrating intermittent VBA error dialog telling me that "User-define Type Not Defined"
Replies
1
Views
257
Micron
M
drom
  • Solved
Pictures.Insert(wURL) does not work with some images
Replies
2
Views
417
drom
drom
A
  • Question Question
VBA help - Locking & unlocking on certain times of day
2
Replies
17
Views
460
dmt32
D
S
  • Question Question
VBA Macro to add Header arrays and insert 2 rows
2
Replies
14
Views
1K
slohman
S
J
  • Question Question
Unprotect workbook, find certain RGB cells even if rows are deleted
Replies
1
Views
183
iliace
iliace

Forum statistics

Threads
1,224,616
Messages
6,179,908
Members
452,949
Latest member
beartooth91

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