VB Code to delete Excel Rows 4

[likelylad]

I have this spreadsheet called "Sheet1"
Column A of the spreadsheet contains the information I need.
I would like the VB code to cycle through each row.
If the cell on column A is null or contains a value less 1000 then this row will be deleted.
The maximum amount of consecutive rows that may contain a null cell is 5 (within the data range).
This is important as once it reaches the end of the information there is obviously nothing but null cells and may get itself into an infinite loop.

One way I was thinking of getting round this problem, was to simply highlight the cells to be deleted and get it to loop through all lines until it had deleted six consecutive rows and run the delete command at the end.

I would be grateful if someone would help me with the coding of this

[Pipe]

 

[RobBroekhuis]

This should work:

i=1
ConsecDelete=0
do
   if cells(i,1)<1000 then
      cells(i,1).entirerow.delete
      ConsecDelete=ConsecDelete+1
   else
      i=i+1
      ConsecDelete=0
   endif
loop until ConsecDelete>5

I haven't tried it - give it a go and see if it does the job.
Rob

 

[dwilson01]

This should do the trick.

Sub del1000()

Dim oCell As Object

ActiveSheet.UsedRange
For Each oCell In ActiveSheet.UsedRange.Columns(1).Cells
skipnext:
  If oCell < 1000 Or oCell = &quot;&quot; Then
    oCell.Activate
    ActiveCell.EntireRow.Delete
    ActiveSheet.UsedRange
    Set oCell = ActiveCell
    GoTo skipnext
  End If
Next

End Sub

Dave

 

[likelylad]

Thanks very much for your help on this
RobBroekhuis your code worked first time.
dwilson01 your code worked but it loops at the end and I had to escape out of it.

I also discovered that some of the cells contain text value, what code would I have to put in to remove text

 

[StevePB]

Hey likelylad,

I've had to do this recently - you can type:

Option Compare Text

in the declarations section of your code (this stops VB differentiating between upper and lower case text) then use the following modification to RobBroekhuis' code:

Sub deleteRows()

i = 1
ConsecDelete = 0
Do
  If Cells(i, 1) < 1000 _
       Or (Cells(i, 1) >= &quot;a&quot; _
       And Cells(i, 1) <= &quot;Z&quot;) Then
    Cells(i, 1).EntireRow.Delete
    ConsecDelete = ConsecDelete + 1
  Else
    i = i + 1
    ConsecDelete = 0
  End If
Loop Until ConsecDelete > 5

End Sub

Hope this helps, SteveB.

 

[dwilson01]

I should try the code before I post, I'll remember to do that in the future. Anyway, for what it's worth here is a revised version that deletes rows that the first column contains anything but numbers >= 1000.

Dim oCell As Object

ActiveSheet.UsedRange
For Each oCell In ActiveSheet.UsedRange.Columns(1).Cells
skipnext:
  If oCell < 1000 Or IsNumeric(oCell) = False Then
    oCell.Activate
    ActiveCell.EntireRow.Delete
    ActiveSheet.UsedRange
    Set oCell = ActiveCell
    If Application.Intersect(Range(oCell.Address), _
      Range(ActiveSheet.UsedRange.Address)) _
      Is Nothing Then Exit Sub
    GoTo skipnext
  End If
Next