There has got to be a better way

[Pete]

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("C1011").Select: Selection.ClearContents
Range("F10:G11").Select: Selection.ClearContents
Range("I10:J11").Select: Selection.ClearContents
Range("L10:M11").Select: Selection.ClearContents
Range("O1011").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("C1516").Select: Selection.ClearContents
Range("F15:G16").Select: Selection.ClearContents
Range("I15:J16").Select: Selection.ClearContents
Range("L15:M16").Select: Selection.ClearContents
Range("O1516").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

 

[Bob Phillips]

Pete,

Is this good enough for you

Sub ClearPRLine()
Dim sRange As String
Dim iStart As Long, iEnd As Long

Select Case ActiveCell.Row
Case 10, 11
ClearCells 10, 11
Case 15, 16
ClearCells 15, 16
Case 20, 21
ClearCells 20, 21
Case 25, 26
ClearCells 25, 26
Case 35, 36
ClearCells 35, 36
Case 40, 41
ClearCells 40, 41
End Select

End Sub

Private Sub ClearCells(start As Long, Finish As Long)
Dim sRange As String
'Clear the contents of columns C,D F,G I,J L,M O,P
'now clear the contents of row " & Finish & " columns E, H, K, N, Q
sRange = "C" & start & "" & Finish & ",F" & start & ":G" & Finish & _
",I" & start & ":J" & Finish & ",L" & start & ":M" & Finish & _
",O" & start & "" & Finish & ","
sRange = sRange & "E" & Finish & ",H" & Finish & ",K" & Finish & ",N" &
Finish & ",Q" & Finish & ",M" & Finish + 2
Range(sRange).ClearContents
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Roger Whitehead]

Pete,

Wherever you see
Select
and
Selection close together, you can generally delete them both:

Range("C1011").ClearContents

'Furthermore:

Case 10, 11
range("C1011,F10:G11,I10:J11").clearcontents

 

[pikus]

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("C1011").Value = ""
Range("F10:G11").Value = ""
Range("I10:J11").Value = ""
Range("L10:M11").Value = ""
Range("O1011").Value = ""
ec...

Selecting a range is very time consuming and often unnecessary. Yo
can also start your code with the line:
Application.ScreenUpdating = False

and end with:
Application.ScreenUpdating = True

It will run much faster if the computer doesn't have to waste tim
updating the screen after every change. - Piku

 

[Tom Ogilvy]

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,F:G,I:J,L:M,O")
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

 

[Tom Ogilvy]

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,F:G,I:J,L:M,O")
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