Multiple Macros on one sheet not working

[GATA_Spread]

I am trying to add macros to a worksheet that will protect certain cells based on the values from other cells. There will be three different ranges that are all affected by sperate, independent cells. I've created the first macro and it works for the first range, but can't figure out how to add in for the other two ranges for it to work properly. Here's the Macro, again it works for range B1:B4 when A1 is "Yes", but I also need the same to work for Range C1:C4 when A5 is "Yes", and D1:D4 to work when A10 is "Yes".

Private Sub Worksheet_Activate()
If Not ActiveSheet.ProtectContents Then
Range("A1").Locked = False
Range("B1:B4").Locked = False
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range, xRgA As Range
On Error Resume Next
Application.EnableEvents = False
Set xRg = Range("B1:B4")
Set xRgA = Range("A1")
If Intersect(Target, xRg).Address <> Target.Address _
Or xRgA = "Yes" Then
Application.EnableEvents = True
Exit Sub
ElseIf ActiveSheet.ProtectContents _
And Intersect(Target, xRg) = Target _
And xRgA.Value <> "Yes" Then
xRgA.Select
End If
Application.EnableEvents = True
End Sub

 

[offthelip]

You don't need to switch the events on and off because you are not changing the wokrhseet with your code only the selected cell. The logic can also be simplified , so I thiunk this does what you asked for:
(untested):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range, xRgA As Range
On Error Resume Next
'Application.EnableEvents = False
Set xRg = Range("B1:B4")
Set xRgC = Range("C1:C4")
Set xRgD = Range("D1:D4")
Set xRgA = Range("A1")
Set xRgA5 = Range("A5")
Set xRgA10 = Range("A10")
If ActiveSheet.ProtectContents Then
If Not (Intersect(Target, xRg) Is Nothing) Then
    If xRgA.Value <> "Yes" Then
    xRgA.Select
    End If
End If
If Not (Intersect(Target, xRgC) Is Nothing) Then
    If xRgA5.Value <> "Yes" Then
    xRgA5.Select
    End If
End If
If Not (Intersect(Target, xRgD) Is Nothing) Then
    If xRgA10.Value <> "Yes" Then
    xRgA10.Select
    End If
End If
End If
End Sub

Note I changed the test for whether the change is in the range of interest to the "standard" method which only executes if the change need to be dealt with

 

[dmt32]

Hi,

welcome to the forum

See if this update to your code does what you want

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim xRg                 As Range, xRgA As Range
    Dim i                   As Long
   
    On Error GoTo exitsub
   
    Set xRg = Range("B1:B4,C1:C4,D1:D4")
    Set xRgA = Range("A1,A5,A10")
   
    If Me.ProtectContents Then
        If Not Intersect(Target, xRg) Is Nothing Then
            Application.EnableEvents = False
            For i = 1 To xRg.Areas.Count
                If Not Intersect(Target, xRg.Areas(i)) Is Nothing Then
                    If xRgA.Areas(i).Value <> "Yes" Then xRgA.Areas(i).Select
                    Exit For
                End If
            Next i
        End If
    End If
   
exitsub:
    Application.EnableEvents = True
End Sub

Note: the code is selecting another range and in doing so, the SelectionChange event will call itself – to prevent this recursion, turning events off in my view, is a sensible step.

Hope Helpful

Dave

 

[GATA_Spread]

You don't need to switch the events on and off because you are not changing the wokrhseet with your code only the selected cell. The logic can also be simplified , so I thiunk this does what you asked for:
(untested):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range, xRgA As Range
On Error Resume Next
'Application.EnableEvents = False
Set xRg = Range("B1:B4")
Set xRgC = Range("C1:C4")
Set xRgD = Range("D1:D4")
Set xRgA = Range("A1")
Set xRgA5 = Range("A5")
Set xRgA10 = Range("A10")
If ActiveSheet.ProtectContents Then
If Not (Intersect(Target, xRg) Is Nothing) Then
    If xRgA.Value <> "Yes" Then
    xRgA.Select
    End If
End If
If Not (Intersect(Target, xRgC) Is Nothing) Then
    If xRgA5.Value <> "Yes" Then
    xRgA5.Select
    End If
End If
If Not (Intersect(Target, xRgD) Is Nothing) Then
    If xRgA10.Value <> "Yes" Then
    xRgA10.Select
    End If
End If
End If
End Sub

Note I changed the test for whether the change is in the range of interest to the "standard" method which only executes if the change need to be dealt with

That worked, thank you for the assitance