Make code shorter

[Juriemagic]

Hi good people!,

I need to add another 40 ranges to this code, and I'm afraid it might slow Excel down. Could anyone please help me make this code shorter? The code is:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C9:O9")) Is Nothing Then
With Sheets("Work Order 1")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C12:O12")) Is Nothing Then
With Sheets("Work Order 2")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C15:O15")) Is Nothing Then
With Sheets("Work Order 3")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C18:O18")) Is Nothing Then
With Sheets("Work Order 4")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C21:O21")) Is Nothing Then
With Sheets("Work Order 5")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C24:O24")) Is Nothing Then
With Sheets("Work Order 6")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C27:O27")) Is Nothing Then
With Sheets("Work Order 7")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C30:O30")) Is Nothing Then
With Sheets("Work Order 8")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C33:O33")) Is Nothing Then
With Sheets("Work Order 9")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C36:O36")) Is Nothing Then
With Sheets("Work Order 10")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C39:O39")) Is Nothing Then
With Sheets("Work Order 11")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C42:O42")) Is Nothing Then
With Sheets("Work Order 12")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C45:O45")) Is Nothing Then
With Sheets("Work Order 13")
.Range("P3").Value = 0
End With
End If
If Not Intersect(Target, Range("C48:O48")) Is Nothing Then
With Sheets("Work Order 14")
.Range("P3").Value = 0
End With
End If
End Sub

All and any help will be accepted with great humility and appreciation!..Thank you all..

[snb]

    Application.Intersect(Range("9:9,12:12,15:15,18:18,21:21"), Range("C:O")).Select

[SamT]

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim Rw as Long 
    If Intersect(Target, Range("C:O")) Is Nothing Exit Sub
    Rw = Target.Row

     If Not Rw Mod 3 = 0 Then Exit Sub
    If Rw < 9 Then Exit Sub
    If Rw > 141 Then Exit Sub 'Adjust to suit
    
    Sheets("Work Order 2").Range("P3").Value = 0 
End Sub

Alternately, Cut an empty column for the far right of the worksheet and Insert it at column P. In this helper column, to be hidden, in the Rows you want, enter some code word, for example: "P3"

Private Sub Worksheet_Change(ByVal Target As Range) 
If Range("P" & Target.Row) = "P3" Then Sheets("Work Order 2").Range("P3").Value = 0
End Sub

Cut and Insert will not mess up any formulas on the sheet.

[Juriemagic]

SamT,

thanx for the response, I'll try this a bit later as something else has come up...will let you know...thanx a lot..

[snb]

(9-6) \3 =1
(12-6)\3=2
(15-6)\3=3, etc.

[Paul_Hossler]

Target doesn't necessarily have to be just one cell

If you select D7 : D22 and control-enter a change, you'd want Sheets 2,3,4,5 to change

Same for selecting more than one area

Also probably a good idea to disable events while you're changing other worksheets

Option Explicit

'Target could be D9 (1 cell)
'    or D7:D22 (multiple cells, 1 area)
'    or D7:D22;M;M;O25:Q55  (multiple cells, multiple areas)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rRow As Range, rTarget As Range
    Dim n As Long
    
    Set rTarget = Intersect(Target, Range("C:O"))
    If rTarget Is Nothing Then Exit Sub
    
    
    For Each rRow In rTarget.Rows
        If rRow.Row Mod 3 = 0 And rRow.Row > 11 Then
    
            n = (rRow.Row - 6) \ 3  '   note: \ (not /) for integer division
            Application.EnableEvents = False
'           Sheets("Work Order " & n).Range("P3").Value = 0
            MsgBox rRow.Row & " goes to " & "Work Order " & n
            Application.EnableEvents = True
        End If
    Next
End Sub