VBA- Help make code more efficient?

[jkeyes]

So the following bit of code seems to really bog down my system and take a loooong time to run... I'm wondering if there's a more effective way to go about this?

Essentially I need it to go through a set of records (typically 6k - 10k rows) and if it meets a couple criteria, delete that row.

My code:

    For x = LastRow To 2 Step -1
        If ActiveSheet.Cells(x, 6).Value < 5000 Or _
            ActiveSheet.Cells(x, 3) = "A" Or _
            ActiveSheet.Cells(x, 3) = "B" Or _
            ActiveSheet.Cells(x, 3) = "C" Or _
            ActiveSheet.Cells(x, 3) = "D" Or _
            ActiveSheet.Cells(x, 3) = "E" Then
           Rows(x).Delete
        End If
    Next x

Any and all help is greatly appreciated!

 

[brian.wethington]

You may look into creating autofilters and delete what is not hidden from the filter.

 

[VoG]

This may speed it up:

Application.ScreenUpdating = False
Application.Calculation = xlManual
For x = LastRow To 2 Step -1
        If ActiveSheet.Cells(x, 6).Value < 5000 Or _
            ActiveSheet.Cells(x, 3) = "A" Or _
            ActiveSheet.Cells(x, 3) = "B" Or _
            ActiveSheet.Cells(x, 3) = "C" Or _
            ActiveSheet.Cells(x, 3) = "D" Or _
            ActiveSheet.Cells(x, 3) = "E" Then
           Rows(x).Delete
        End If
    Next x
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

 

[brian.wethington]

Here is an example of how I use autofilter to do this:

    Set C = Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not C Is Nothing Then
        LstRw = C.Row
        Range("a8").AutoFilter Field:=10, Criteria1:="=c*"
        Rows("8:" & LstRw).EntireRow.Delete
        Range("A8").AutoFilter Field:=10
        Range("A8").AutoFilter Field:=8, Criteria1:="=Hold"
        Rows("8:" & LstRw).EntireRow.Delete
        Range("A8").AutoFilter
    End if

This filters starting row 8 (7 is a header column) and field 10. If field 10 starts with a "C" then it will be deleted from row 8 to LstRw. The filter will then be removed and then it will be filtered by field 8 and if column 8 contains the word hold it will be deleted from row 8 to LstRow. Hope you can develop this train of though for your needs... Have a great day!

 

[Jon Peltier]

ADVERTISEMENT

A further refinement of VoG's code:

Dim r as Range
Application.ScreenUpdating = False 
Application.Calculation = xlManual 
For x = LastRow To 2 Step -1 
        If ActiveSheet.Cells(x, 6).Value < 5000 Or _ 
            ActiveSheet.Cells(x, 3) = "A" Or _ 
            ActiveSheet.Cells(x, 3) = "B" Or _ 
            ActiveSheet.Cells(x, 3) = "C" Or _ 
            ActiveSheet.Cells(x, 3) = "D" Or _ 
            ActiveSheet.Cells(x, 3) = "E" Then 
          If r Is Nothing then
            Set r = Rows(x)
          Else
            Set r=Union(r, Rows(x))
          End If
        End If 
    Next x 
    r.Delete
Application.ScreenUpdating = True 
Application.Calculation = xlAutomatic

 

[Diffy]

            ActiveSheet.Cells(x, 3) = "A" Or _ 
            ActiveSheet.Cells(x, 3) = "B" Or _ 
            ActiveSheet.Cells(x, 3) = "C" Or _ 
            ActiveSheet.Cells(x, 3) = "D" Or _ 
            ActiveSheet.Cells(x, 3) = "E" Then

I am not sure but I think you can do something like this:

     ActiveSheet.Cells(x, 3) >= "A" And_
            ActiveSheet.Cells(x, 3) <= "E"

 

[jkeyes]

Thanks! The manual calc setting did the trick!

D'oh, should've thought of that myself!

 

[dcardno]

Two things (might) help. You are reading the character values 5 times - and perhaps reading them when the "less than 5000" test has already been passed (or failed...) and the row is going to be deleted anyway; I would suggest an "If test" - if the value in Col F is less than 5K just delete the row, and don't bother reading the character values in Col C

Second, you are using (and reading) the same value five times - if you can read it once it might speed things up. You could either read and assign it to a variable, and then test the variable, or (I think preferably) you could just test once. This is Air Code but something like this might work:

For x = LastRow To 2 Step -1 
   If ActiveSheet.Cells(x, 6).Value < 5000 Then
rows(x) Delete
   Else
      Select Case ActiveSheet.Cells(x, 3)
         Case "A" To "E": Rows(x).Delete 
      End Select
   End If
Next x