Range selection

[m1ke]

Hi all,

I found a macro on the net that does pretty much what I want, apar
from the fact that it only searches 1 column - not a range of column
as I would like.

Here is the code...


Code
-------------------
Sub Delete_Rows()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("J:J"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "1" Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Su
-------------------


Basically, I require the macro to search through every cell in column
J to R, and when it finds a "1", delete the entire row. As you can see
the above works for just column J, but I'm not sure of the correc
syntax when trying to select a range of columns.

Any help appreciated

 

[Bob Phillips]

Just change the line

Set rng = Intersect(Range("J:J"), ActiveSheet.UsedRange)

to

Set rng = Intersect(Range("J:R"), ActiveSheet.UsedRange)


--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[m1ke]

Hi Bob,

Thanks for your reply.

Sorry, I should have mentioned that I did try what you suggested befor
I made the original post. However, it doesn't seem to work. It doesn'
give any error messages, but it doesn't remove 1's from any column.

Any ideas

 

[m1ke]

Hmm, it just doesn't seem to like it when I try and select one or more
columns.


Code:

 

[m1ke]

*bump* Sorry guys ;

 

[Dave Peterson]

One way:

Option Explicit
Sub Delete_Rows()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("J:R"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "1" Then
If del Is Nothing Then
Set del = cell.EntireRow.Cells(1)
Else
Set del = Union(del, cell.EntireRow.Cells(1))
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[m1ke]

Great stuff! Thanks Dave.