Can anyone correct this code ???

[colwyn]

This code is designed to delete rows which dont have data in column I.
However, after several hours running, it just freezes up the s/s and I
have to close it down.



Code:
--------------------

Sub delRows()
Dim rClear As Range
Dim Rw As Long
Dim LastRw As Long


With ActiveSheet
LastRw = .Cells(.Rows.Count, 1).End(xlUp).Row
For Rw = LastRw To 3 Step -1
If Application.WorksheetFunction.CountA(.Range(.Cells(Rw, 1), .Cells(Rw, 10))) = 2 Then
If rClear Is Nothing Then
Set rClear = .Cells(Rw, 1)
Else: Set rClear = Union(rClear, Cells(Rw, 1))
End If
End If
Next Rw
rClear.EntireRow.Delete
End With
End Sub

--------------------




Can anyone tell me what is wrong and/or correct the code to make it
workable??
Big thanks.
Colwyn.

 

[JE McGimpsey]

Your specification says "delete rows which dont (sic) have data in
column I". However, your code is set to clear rows that have exactly 2
filled cells in columns A:J.

To meet your first objective (blanks in I), one way:

Public Sub delRowsinColumnI()
Dim rClear As Range
Dim rCell As Range

With ActiveSheet
For Each rCell In .Range(.Cells(3, 9), _
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 8))
If IsEmpty(rCell.Value) Then
If rClear Is Nothing Then
Set rClear = rCell
Else
Set rClear = Union(rClear, rCell)
End If
End If
Next rCell
End With
If Not rClear Is Nothing Then rClear.EntireRow.Delete
End Sub

 

[colwyn]

JE McGimpsey, thanks. Here is what I want to do (please see attachmen
for layout): I want to delete those rows which ONLY have data in column
A and J.
The attachment is very small and the code works fine on it - but my s/
is over 330000 rows deep.
Can you help?
Big thanks.
Colwyn

 

[JE McGimpsey]

Fortunately, there was no attachment (if you can even attach via your
newsreading method) - my newsreader screens out attachments. Few people
would open unsolicited attachments.

One way:

Public Sub DeleteRowsWithOnlyAandJ()
Dim rClear As Range
Dim rCell As Range

With ActiveSheet
For Each rCell In .Range(.Cells(3, 1), _
.Cells(.Rows.Count, 1).End(xlUp))
With rCell
If Not IsEmpty(.Value) And _
Not IsEmpty(.Offset(0, 9).Value) Then
If Application.CountA(.EntireRow) = 2 Then
If rClear Is Nothing Then
Set rClear = .Cells
Else
Set rClear = Union(rClear, .Cells)
End If
End If
End If
End With
Next rCell
End With
If Not rClear Is Nothing Then rClear.EntireRow.Delete
End Sub

 

[colwyn]

The attachment is in my initial posting at the top

This is how it comes out if I post s/s content here

series name rank age points

1 joe 1 22 2 1 red
1 fred 2 45 2 red 1760 re
1 anne 3 31 2 102.97 red
1 david 4 66 3 101.16 red
1 peter 5 21 5 red
1 alison 6 68 6 red
1 red X
1 red X

2 stuart 1 95 4 2 red
2 joan 2 33 6 red 2200 red
2 tim 3 46 7 133.97 red
2 128.51 red
2 red X
2 red X


It just doesn't work

 

[Rick Rothstein]

There is a limit to how many non-contiguous areas can be grouped using a
Union (I think it was 8000+, whichever power of 2 equates to that); but
**well** before that limit is reached, the time required to perform the
Union will start to bog down. Here is a code module that accounts for the
above, and also shuts off automatic calculations and screen updating to help
speed things up, and which I believe implements the conditions you have
mentioned for the rows to be deleted. Give it a try (on a copy of your data;
macro deletions cannot be undone) and let me know how it works out...

***************** START OF CODE *****************
Sub DeleteRowsWithDataOnlyInAandJ()
Dim X As Long
Dim LastRow As Long
Dim OriginalCalculationMode As Long
Dim RowsToDelete As Range

On Error GoTo Whoops
OriginalCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With ActiveSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For X = LastRow To 3 Step -1
If .Cells(X, 1).Value <> "" And .Cells(X, 10) <> "" And _
WorksheetFunction.CountA(.Cells(X, 1).EntireRow) = 2 Then
If RowsToDelete Is Nothing Then
Set RowsToDelete = .Cells(X, 1)
Else
Set RowsToDelete = Union(RowsToDelete, .Cells(X, 1))
End If
If RowsToDelete.Areas.Count > 100 Then
RowsToDelete.EntireRow.Delete
Set RowsToDelete = Nothing
End If
End If
Next
End With
If Not RowsToDelete Is Nothing Then
RowsToDelete.EntireRow.Delete
End If

Whoops:
Application.Calculation = OriginalCalculationMode
Application.ScreenUpdating = True
End Sub
***************** END OF CODE *****************

 

[colwyn]

Rick Rothstein, thanks again. I've copy-pasted your code but when I
click "Run" absolutely nothing happens on the s/s
??????

 

[Rick Rothstein]

Can you have other data in the row in columns after "J"? If so, try this
version of the code instead (I should have coded it this way in the first
place) ...

***************** START OF CODE *****************
Sub DeleteRowsWithDataOnlyInAandJ()
Dim X As Long
Dim LastRow As Long
Dim OriginalCalculationMode As Long
Dim RowsToDelete As Range

On Error GoTo Whoops
OriginalCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With ActiveSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For X = LastRow To 3 Step -1
If .Cells(X, 1).Value <> "" And .Cells(X, 10) <> "" And _
WorksheetFunction.CountA(.Range(Cells(X, 1), _
Cells(X, 10))) = 2 Then
If RowsToDelete Is Nothing Then
Set RowsToDelete = .Cells(X, 1)
Else
Set RowsToDelete = Union(RowsToDelete, .Cells(X, 1))
End If
If RowsToDelete.Areas.Count > 100 Then
RowsToDelete.EntireRow.Delete
Set RowsToDelete = Nothing
End If
End If
Next
End With
If Not RowsToDelete Is Nothing Then
RowsToDelete.EntireRow.Delete
End If

Whoops:
Application.Calculation = OriginalCalculationMode
Application.ScreenUpdating = True
End Sub
***************** END OF CODE *****************

 

[colwyn]

Thanks Rick - that one works just fine.
Big thanks.
Colwyn