Multiple "Worksheet_Change" routines

seventy9mph

Board Regular
Joined
Apr 16, 2009
Messages
72
here is my code, and I need help either combining the two Worksheet_Change routines or getting another way to do this. Thanks in advance



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$I$2" Then Exit Sub
If Target = "GB" Then
ActiveSheet.Unprotect ("Branches080704")
Application.EnableEvents = False
Range("$F$6:$F$8").ClearContents
Range("$F$4").Locked = False
Range("$F$5:$F$8").Locked = True
Range("$G$6:$G$8").Locked = True
Application.EnableEvents = True
ActiveSheet.Protect ("Branches080704")
Else
If Target.Address <> "$I$2" Then Exit Sub
If Target = "VC" Then
ActiveSheet.Unprotect ("Branches080704")
Application.EnableEvents = False
Range("$F$4").Locked = False
Range("$F$6").Locked = False
Range("$F$7").Locked = False
Range("$F$8").Locked = False
Range("$F$5").Locked = True
Range("$G$6:$G$8").Locked = True
Application.EnableEvents = True
ActiveSheet.Protect ("Branches080704")
Else
If Target.Address <> "$I$2" Then Exit Sub
If Target = "DONE" Then
ActiveSheet.Unprotect ("Branches080704")
Application.EnableEvents = False
Range("$F$4").ClearContents
Range("$F$6:$F$8").ClearContents
Range("$F$4:$G$8").Locked = True
Application.EnableEvents = True
ActiveSheet.Protect ("Branches080704")
Else
End If
End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$P$2" Then Exit Sub
If Target = "GB" Then
ActiveSheet.Unprotect ("Branches080704")
Application.EnableEvents = False
Range("$M$6:$M$8").ClearContents
Range("$M$4").Locked = False
Range("$M$5:$M$8").Locked = True
Range("$N$6:$N$8").Locked = True
Application.EnableEvents = True
ActiveSheet.Protect ("Branches080704")
Else
If Target.Address <> "$P$2" Then Exit Sub
If Target = "VC" Then
ActiveSheet.Unprotect ("Branches080704")
Application.EnableEvents = False
Range("$M$4").Locked = False
Range("$M$6").Locked = False
Range("$M$7").Locked = False
Range("$M$8").Locked = False
Range("$M$5").Locked = True
Range("$N$6:$N$8").Locked = True
Application.EnableEvents = True
ActiveSheet.Protect ("Branches080704")
Else
If Target.Address <> "$P$2" Then Exit Sub
If Target = "DONE" Then
ActiveSheet.Unprotect ("Branches080704")
Application.EnableEvents = False
Range("$M$4").ClearContents
Range("$M$6:$M$8").ClearContents
Range("$M$4:$N$8").Locked = True
Application.EnableEvents = True
ActiveSheet.Protect ("Branches080704")
Else
End If
End If
End If
End Sub
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Sal Paradise

Well-known Member
Joined
Oct 23, 2006
Messages
2,457
Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim intColumn As Integer
    
    If Intersect(Target, Range("I2"), Range("P2")) Is Nothing Then
        Exit Sub
    End If
                
    Select Case Target.Address
        Case "$I$2"
            intColumn = 5
        Case "$P$2"
            intColumn = 13
    End Select

    Application.EnableEvents = False
    ActiveSheet.Unprotect ("Branches080704")
    
    If Target = "GB" Then
        Cells(intColumn, 6).Resize(3, 1).ClearContents
        Cells(intColumn, 4).Locked = False
        Cells(intColumn, 5).Resize(4, 1).Locked = True
        Cells(intColumn + 1, 6).Resize(3, 1).Locked = True
    ElseIf Target = "VC" Then
        Cells(intColumn, 4).Locked = False
        Cells(intColumn, 6).Resize(3, 1).Locked = False
        Cells(intColumn, 5).Locked = True
        Cells(intColumn + 1, 6).Resize(3, 1).Locked = True
    ElseIf Target = "DONE" Then
        Cells(intColumn, 4).ClearContents
        Cells(intColumn, 6).Resize(3, 1).ClearContents
        Cells(intColumn, 4).Resize(5, 2).Locked = True
    End If
    
    ActiveSheet.Protect ("Branches080704")
    Application.EnableEvents = True

End Sub
Since you're doing the same thing, just with different columns, I simplified it.
 

Watch MrExcel Video

Forum statistics

Threads
1,101,810
Messages
5,483,042
Members
407,375
Latest member
achusp

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top