View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default There has got to be a better way

Missed you were clearing the first set of columns on both rows. Here is a
modification.
Sub Tester1()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim rng4 As Range, rng5 As Range
Set rng1 = Range("C:D,F:G,I:J,L:M,O:P")
Set rng2 = Range("E:E,H:H,K:K,N:N,Q:Q")
Set rng3 = Range("10:11,15:16,20:21,25:26,35:36,40:41")
Set rng4 = Range("10:10,15:15,20:20,25:25,35:35,40:40")
If Intersect(ActiveCell, rng3) Is Nothing Then Exit Sub
Set rng5 = ActiveCell
If Intersect(rng5, rng4) Is Nothing Then
Set rng5 = rng5.Offset(-1, 0)
End If
Intersect(rng5.Resize(2).EntireRow, _
rng1.EntireColumn).ClearContents
Intersect(rng5.Offset(1, 0).EntireRow, _
rng2.EntireColumn).ClearContents
Intersect(rng5.Offset(3, 0).EntireRow, _
Range("M:M")).ClearContents


End Sub

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
This should be all you need.

Sub Tester1()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim rng4 As Range, rng5 As Range
Set rng1 = Range("C:D,F:G,I:J,L:M,O:P")
Set rng2 = Range("E:E,H:H,K:K,N:N,Q:Q")
Set rng3 = Range("10:11,15:16,20:21,25:26,35:36,40:41")
Set rng4 = Range("10:10,15:15,20:20,25:25,35:35,40:40")
If Intersect(ActiveCell, rng3) Is Nothing Then Exit Sub
Set rng5 = ActiveCell
If Intersect(rng5, rng4) Is Nothing Then
Set rng5 = rng5.Offset(-1, 0)
End If
Intersect(rng5.EntireRow, _
rng1.EntireColumn).ClearContents
Intersect(rng5.Offset(1, 0).EntireRow, _
rng2.EntireColumn).ClearContents
Intersect(rng5.Offset(3, 0).EntireRow, _
Range("M:M")).ClearContents


End Sub

--
Regards,
Tom Ogilvy


"Pete" wrote in message
...
There has got to be a better way to do this. But I can not figure it

out.
This procedure works but it seems to be very long.

I thought that seting a variable might help but not sure how to do it.


Sub ClearPRLine()
'user selects row
'
'MsgBox ActiveCell.Row

Select Case ActiveCell.Row

Case 10, 11 ' if user selected one of these rows
'Rows 10 and 11 clear the contents of columns C,D F,G I,J L,M

O,P
Range("C10:D11").Select: Selection.ClearContents
Range("F10:G11").Select: Selection.ClearContents
Range("I10:J11").Select: Selection.ClearContents
Range("L10:M11").Select: Selection.ClearContents
Range("O10:P11").Select: Selection.ClearContents
'now clear the contents of row 11 columns E, H, K, N, Q
Range("E11").Select: Selection.ClearContents
Range("H11").Select: Selection.ClearContents
Range("K11").Select: Selection.ClearContents
Range("N11").Select: Selection.ClearContents
Range("Q11").Select: Selection.ClearContents
'finally clear the contents of row 13 column M
Range("M13").Select: Selection.ClearContents

Case 15, 16
'Rows 15 and 16 clear the contents of columns C,D F,G I,J L,M

O,P
Range("C15:D16").Select: Selection.ClearContents
Range("F15:G16").Select: Selection.ClearContents
Range("I15:J16").Select: Selection.ClearContents
Range("L15:M16").Select: Selection.ClearContents
Range("O15:P16").Select: Selection.ClearContents
'now clear the contents of row 11 columns E, H, K, N, Q
Range("E16").Select: Selection.ClearContents
Range("H16").Select: Selection.ClearContents
Range("K16").Select: Selection.ClearContents
Range("N16").Select: Selection.ClearContents
Range("Q16").Select: Selection.ClearContents
'finally clear the contents of row 13 column M
Range("M18").Select: Selection.ClearContents

Case 20, 21
'same as above but rows 20 and 21
Case 25, 26
'ditto
Case 35, 36
'ditto
Case 40, 41
'ditto
End Select

End Sub