Apply workbook_change to multiple ranges

sdkorin

New Member
Joined
Feb 1, 2018
Messages
22
Office Version
  1. 2016
Platform
  1. Windows
I am trying to lock a row based on the value of the first cell. I've got my VBA working fine for one row, but I need to apply this to multiple rows, all independently.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A13") = "CES" Or Range("A13") = "CES Start" Or Range("A13") = "CES End" Then
        Range("D13:CA13").Locked = False
    ElseIf Range("A13") = "" Then
        Range("D13:CA13").Locked = True
    End If
End Sub

This works for my single row. I just need this to work exactly the same, but independently for each row, for rows 15, 17, 19, 21, 23, 25, 27, 29, 31, 33, 35, and 37.

This is obviously now working, but this gives you the idea of what I'm looking for.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A13") = "CES" Or Range("A13") = "CES Start" Or Range("A13") = "CES End" Then
        Range("D13:CA13").Locked = False
    ElseIf Range("A13") = "" Then
        Range("D13:CA13").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A15") = "CES" Or Range("A15") = "CES Start" Or Range("A15") = "CES End" Then
        Range("D15:CA15").Locked = False
    ElseIf Range("A15") = "" Then
        Range("D15:CA15").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A17") = "CES" Or Range("A17") = "CES Start" Or Range("A17") = "CES End" Then
        Range("D17:CA17").Locked = False
    ElseIf Range("A17") = "" Then
        Range("D17:CA17").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A19") = "CES" Or Range("A19") = "CES Start" Or Range("A19") = "CES End" Then
        Range("D19:CA19").Locked = False
    ElseIf Range("A19") = "" Then
        Range("D19:CA19").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A21") = "CES" Or Range("A21") = "CES Start" Or Range("A21") = "CES End" Then
        Range("D21:CA21").Locked = False
    ElseIf Range("A21") = "" Then
        Range("D21:CA21").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A23") = "CES" Or Range("A23") = "CES Start" Or Range("A23") = "CES End" Then
        Range("D23:CA23").Locked = False
    ElseIf Range("A23") = "" Then
        Range("D23:CA23").Locked = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A25") = "CES" Or Range("A25") = "CES Start" Or Range("A25") = "CES End" Then
        Range("D25:CA25").Locked = False
    ElseIf Range("A25") = "" Then
        Range("D25:CA25").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A27") = "CES" Or Range("A27") = "CES Start" Or Range("A27") = "CES End" Then
        Range("D27:CA27").Locked = False
    ElseIf Range("A27") = "" Then
        Range("D21:CA27").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A29") = "CES" Or Range("A29") = "CES Start" Or Range("A29") = "CES End" Then
        Range("D29:CA29").Locked = False
    ElseIf Range("A29") = "" Then
        Range("D29:CA29").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A31") = "CES" Or Range("A31") = "CES Start" Or Range("A31") = "CES End" Then
        Range("D31:CA31").Locked = False
    ElseIf Range("A31") = "" Then
        Range("D31:CA31").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A33") = "CES" Or Range("A33") = "CES Start" Or Range("A33") = "CES End" Then
        Range("D33:CA33").Locked = False
    ElseIf Range("A33") = "" Then
        Range("D33:CA33").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A35") = "CES" Or Range("A35") = "CES Start" Or Range("A35") = "CES End" Then
        Range("D35:CA35").Locked = False
    ElseIf Range("A35") = "" Then
        Range("D35:CA35").Locked = True
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A37") = "CES" Or Range("A37") = "CES Start" Or Range("A37") = "CES End" Then
        Range("D37:CA37").Locked = False
    ElseIf Range("A37") = "" Then
        Range("D37:CA37").Locked = True
    End If
End Sub

Thoughts? Thank you for the help.
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Hi

Sorry, but the code makes no sense to me.


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A13") = "CES" Or Range("A13") = "CES Start" Or Range("A13") = "CES End" Then
        Range("D13:CA13").Locked = False
    ElseIf Range("A13") = "" Then
        Range("D13:CA13").Locked = True
    End If
End Sub

The idea of the change event is to execute when some condition is met, for ex. if you change cell D3 or if you change a cell in column B.
The way you have this code, it will execute no matter what you change in the worksheet.

Please clarify.
 
Upvote 0
The first cell in each row is a drop down list. It starts out blank, hence "ElseIf Range("A13") = "" Then Range("D13:CA13").Locked = True". If the cell is blank/empty the row will be locked. However, I the user selects "CES", "CES Start", or "CES End" from the dropdown, the row unlocks, allowing the user to input data into that row.

I can get the code to work with one row flawlessly, however, I need the code to work with 13 rows, independently. If A13 says "CES", row 13 is unlocked, but all the other defined rows remain locked. If A13, A21, and A25 say "CES Start", "CES", and "CES End" respectively, rows 13, 21, and 25 are unlocked, and all other defined rows remain locked.

Does that help?
 
Upvote 0
How about
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Target, Range("A13,A15,A17,A19,A21,A23,A25,A27,A29,A31,A33,A35,A37")) Is Nothing Then Exit Sub
    If Target = "" Then
        Intersect(Rows(Target.Row), Range("D:CA")).Locked = True
    Else
        Intersect(Rows(Target.Row), Range("D:CA")).Locked = False
    End If
End Sub
This will lock the cells if the cell in col A is empty & unlock them if A has a value
 
Upvote 0
How about
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Target, Range("A13,A15,A17,A19,A21,A23,A25,A27,A29,A31,A33,A35,A37")) Is Nothing Then Exit Sub
    If Target = "" Then
        Intersect(Rows(Target.Row), Range("D:CA")).Locked = True
    Else
        Intersect(Rows(Target.Row), Range("D:CA")).Locked = False
    End If
End Sub
This will lock the cells if the cell in col A is empty & unlock them if A has a value

It looked good pgc01, but no dice. Nothing happens. Everything remains unlocked, regardless of what is in the first cell. Thoughts?

[TABLE="width: 300"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]0700-0800[/TD]
[TD][/TD]
[TD][/TD]
[TD]Always Unlocked ->[/TD]
[TD]->[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]CES[/TD]
[TD][/TD]
[TD][/TD]
[TD]Unlocked ->[/TD]
[TD]->[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]0800-0900[/TD]
[TD][/TD]
[TD][/TD]
[TD]Always Unlocked ->[/TD]
[TD]->[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Locked ->[/TD]
[TD]->[/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]0900-1000[/TD]
[TD][/TD]
[TD][/TD]
[TD]Always Unlocked ->[/TD]
[TD]->[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
I assume you're talking to me, rather than pgc01, as you've quoted my code. ;)

The code will only lock/unlock the rows where you have changed the value in col A, as that's what your code was doing
 
Upvote 0
As I was. I must have had a "derp" moment on this. The code won't Lock and Unlock the row, unless it was locked initially. As long as I start with the rows locked, the code does exactly what I need it to do, many many thanks. I appreciate it.
 
Upvote 0
Yes, I'm sorry about that. I was working mobile and didn't see the change in user names on the side. Your code works perfectly as long as I start with the rows locked. I appreciate it.
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0
So, this code has worked great, however, I've run into a slight problem, something that I didn't even think about until literally 10 minutes ago. I have hidden cells that do calculation in each row, seeing as the code unlocks the entire row, there is the possibility that someone could erase the formulas in the hidden cells by accident if they make a mistake and try and clear the whole row of data. Is it possible to make this work with specific cells within the row? Specifically "D:E,H,L,N,Q:R,U,Y,AA,AD:AE,AH,AL,AN,AQ:AR,AU,AY,BA,BD:BE,BH,BL,BN,BR:BS,BV,BZ,CB". I tried to see if I could just set these as the defined range, and that didn't work... I am admittedly very new to VBA... Thoughts?

Thanks in advance.
 
Upvote 0

Forum statistics

Threads
1,224,760
Messages
6,180,816
Members
452,996
Latest member
nelsonsix66

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