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