• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 23
  • Last Modified:

Is there a better way to do this?

I have this code but it does take a little time to execute - is there a better approach to this?

Dim lRow
lRow = 3000
Do While lRow >= 2
If Cells(lRow, 9) <> "Successful" Then Rows(lRow).Delete
lRow = lRow - 1
Loop

Open in new window

0
gisvpn
Asked:
gisvpn
  • 3
  • 2
1 Solution
 
Roy CoxGroup Finance ManagerCommented:
Automating AutoFilter will be faster. This code might need adjusting slightly

Option Explicit

Sub deleteFilteredData()
    Dim rDelete    As Range
    Dim lCalc  As Long
    Dim sDelete As String
     
    With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
 On Error GoTo exit_proc
     
     'Obtain the value that you want to delete
    sDelete = "Successful"
  
     
     'Sheet with the data, change the name
    With Sheet1
        .AutoFilterMode = False
         
         'Apply the filter, this range of data starts in A1
        .Cells(1, 1).CurrentRegion.AutoFilter Field:=9, Criteria1:=sDelete
         
        With .AutoFilter.Range
            On Error Resume Next
            Set rDelete = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
            .SpecialCells(xlCellTypeVisible)
'            On Error GoTo 0
            If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
        End With
         'Remove the AutoFilter
        .AutoFilterMode = False
    End With
     
exit_proc:
        .ScreenUpdating = True
        .Calculation = lCalc
    End With
     
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Whenever deleting rows you should do it backward

Dim lRow

For lRow = 3000 to 2 step -1
    If Cells(lRow, 9) <> "Successful" Then Rows(lRow).Delete
Next

Open in new window

0
 
Roy CoxGroup Finance ManagerCommented:
The OP's code already deletes backwards from 3000

Creating a range to delete will be faster

Option Explicit

Sub DeleteRows()
    Dim rRng As Range, rDelete As Range, rCl As Ranges

    Set rRng = Cells(1, 9).CurrentRegion    '///limits the number of Rows

    For Each rCl In rRng
        If rCl.Value <> "Successful" Then
            If rDelete Is Nothing Then
                Set rDelete = rCl
            Else: Set rCl = Union(rDelete, rCl)
            End If
        End If
    Next rCl
    If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub

Open in new window


However, AutoFilter will be faster than a Loop.

Note the criteia in my earlier post should be <> "Successful" not ="Successful"
0
 
Roy CoxGroup Finance ManagerCommented:
Just spotted an typo in the code, it should be

Option Explicit

Sub DeleteRows()
    Dim rRng As Range, rDelete As Range, rCl As Ranges

    Set rRng = Cells(1, 9).CurrentRegion    '///limits the number of Rows

    For Each rCl In rRng
        If rCl.Value <> "Successful" Then
            If rDelete Is Nothing Then
                Set rDelete = rCl
            Else: Set rDelete = Union(rDelete, rCl)
            End If
        End If
    Next rCl
    If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub
0
 
Martin LissOlder than dirtCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now