Delete a row containing specific text - working but slow on larger number of records

ngowanlock · Jul 9th 2016

I have the following vba code I picked up on stack overflow sometime back, the macro deletes records where the number 1 is present in column A but once this encounters several hundred rows the speed is very slow can anyone suggest a faster method to achieve the same?

Code

Sub deleteBlankRows()


Dim lRow As Long




Dim iCntr As Long




lRow = 750




For iCntr = lRow To 1 Step -1
If Cells(iCntr, 1) = 1 Then
Rows(iCntr).Delete
End If
Next




End Sub

Display More

credits for original macro this was derived from: stackoverflow.com/questions/27927042/find-and-delete-rows-where-cell-value-is-n-a

ngowanlock · Jul 11th 2016

Re: Delete a row containing specific text - working but slow on larger number of reco

Fastest method I've come up with is doing the following by using filters, this achieves an instant result regardless the number of records not sure if its the nicest way to do it, but its works! This assumes no header row present.

Code

Sub Delete_1s()


    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$J$750").AutoFilter Field:=1, Criteria1:="=1", _
        Operator:=xlAnd
    Cells.Select
    Selection.ClearContents
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    
End Sub

Display More

**Trebor76** · Jul 12th 2016

Re: Delete a row containing specific text - working but slow on larger number of reco

Hi ngowanlock,

Here's another method that uses a helper column which as a result of not looping is very fast:

Code

Option Explicit
Sub Macro1()


    Const lngStartRow As Long = 1 'Starting data row number. Change to suit.
    
    Dim lngMyCol As Long, _
        lngMyRow As Long
    Dim xlnCalcMethod As XlCalculation
            
    With Application
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With


    lngMyCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    lngMyRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With Columns(lngMyCol)
        With Range(Cells(lngStartRow, lngMyCol), Cells(lngMyRow, lngMyCol))
            .Formula = "=IF(A1=1,NA(),"""")"
            ActiveSheet.Calculate
            .Value = .Value
        End With
        On Error Resume Next 'Turn error reporting off - OK to ignore 'No cells found' message
            .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
        On Error GoTo 0 'Turn error reporting back on
        .Delete
    End With
    
    With Application
        .Calculation = xlnCalcMethod
        .ScreenUpdating = True
    End With


    MsgBox "All rows from Col. A where the balance was equal to 1 have now been deleted.", vbInformation


End Sub

Display More

Regards,

Robert

apo · Jul 12th 2016

Re: Delete a row containing specific text - working but slow on larger number of reco

An another different way..

Borrowed one of Jindons lovely lines to build the 1D array.

You might need to adapt is slightly to suit.. check out the attachment..

Code

Private Sub CommandButton1_Click()
    Dim Z, X
    With [A1].CurrentRegion
        ' Put original Values into a 2D Array
        Z = .Value
        
        ' Populate a 1D array with row numbers that DON'T have "1" in column A.
        ' >>>>>> This line is one of Jindons beauties <<<<<<
        X = Filter(Evaluate("transpose(if((" & .Columns("A").Address & _
        "<>1),row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
        
        ' Exit Sub if Array is Empty
        If UBound(X) = -1 Then Exit Sub
        
        ' Dump result to Sheet
            .ClearContents
            [A1].Resize(UBound(X) + 1, UBound(Z, 2)) = Application.Index(Z, Application.Transpose(Array(X)), [transpose(row(1:7))])
    End With
End Sub

Display More

Edit: Just thought about it.. change the line where it dumps the result to sheet to the below so the column count is dynamic.

Code

[A1].Resize(UBound(X) + 1, UBound(Z, 2)) = Application.Index(Z, Application.Transpose(Array(X)), Evaluate("Transpose(Row(1:" & UBound(Z, 2) & "))"))

Delete a row containing specific text - working but slow on larger number of records

Participate now!

Share