CODEWITHSUNDEEP
excelvba
Li_DE
Li_DE

Reputation: 39

Delete specifics rows in a sheet with more than 60000 rows

I need to delete the rows that: - Does not have the Word "Get" into Column A, example: if A1 is Configuration Get, I should not delete; but if it is nFormat or anything else, I should delete. - And for the rows which has the word "get" I also need to check if in Column C the value is 0, if it is not 0 I also should delete.

My function is working for sheet with a small number of rows, but the problem is, I really need to run it for a large number, let's say for 60000 rows. Could someone help me?

My function is:

Sub DeleteRows()

   Dim c As Range
   Dim ColumnA
   Dim Lrow As Long
   Dim Lastrow As Long

With Sheets("Sheet1") 'I'm using the Sheet1
.Select

   Set ColumnA = ActiveSheet.UsedRange
   Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

For Lrow = Lastrow To 1 Step -1

Set ColumnA = Cells(Lrow, "A") 'I'm looking just in Column "A" for a Get

       Set c = ColumnA.Find("Get", LookIn:=xlValues)
       If Not c Is Nothing Then
            ' If the cell has a Get, it will look for a 0 in Column "C"
            With .Cells(Lrow, "C")
                If Not IsError(.Value) Then
                    ' If the Value is not 0 the row will be delete.
                    If Not (.Value = 0) Then .EntireRow.Delete
                End If
            End With

        Else
        'If didn't find a "Get", it will delete the row
        ColumnA.EntireRow.Delete

        End If      
Next Lrow

End With

End Sub

Upvotes: 1

Views: 633

Answers (2)

CRondao
CRondao

Reputation: 1903

I did like this for, in this case sheet7, and it worked:

Application.ScreenUpdating = False
With Sheet7
 r = 1
 Do While r <= LastRow
  If IsError(.Cells(r, 1)) Then
   .Rows(r).Delete
   LastRow = LastRow - 1
  Else
   If InStr(.Cells(r, 1), "Get") = 0 Then
    .Rows(r).Delete
    LastRow = LastRow - 1
   Else
    r = r + 1
   End If
  End If
 Loop
End With
Application.ScreenUpdating = True

Upvotes: 0

brettdj
brettdj

Reputation: 55682

Try something like this which uses AutoFilter instead

It is the VBA equivalent of:

  1. finding the first blank column
  2. entering =OR(ISERROR(FIND("Get",$A1)),AND(NOT(ISERROR(FIND("Get",$A1))),$C1<>0)) in row 1 and copying down
  3. deleting and TRUE results
  4. cleaning up the working column

code 

Sub KillEm()
    Dim rng1 As Range, rng2 As Range, rng3 As Range
    Set rng1 = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious)
    Set rng2 = Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
    Set rng3 = Range(Cells(rng2.Row, rng1.Column), Cells(1, rng1.Column))
    Application.ScreenUpdating = False
    With rng3.Offset(0, 1)
        .FormulaR1C1 = "=OR(ISERROR(FIND(""Get"",RC1)),AND(NOT(ISERROR(FIND(""Get"",RC1))),RC3<>0))"
        .AutoFilter Field:=1, Criteria1:="TRUE"
        .Offset(1, 0).Resize(rng3.Rows.Count - 1, 1).EntireRow.Delete
        .EntireColumn.Delete
    End With
    Application.ScreenUpdating = True
End Sub

Upvotes: 1

Related Questions