Delete entire rows if ...: how to speed up the process?

[Nelson78]

Hello everybody.

I have 500k rows to check.
If cell "H" is not beginning for "CODE", then delete entire row.

How You can imagine, with a such amount of rows the process takes too long.

How can I speed up? May be with a REGEX strategy?

Sub deleterows()

Dim rw As Long

    With Worksheets(1)
        For rw = .Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
            If Not Cells(rw, "H").Value Like "CODE*" Then
                .Rows(rw).EntireRow.Delete
            End If
        Next rw
    End With

End Sub

 

[Nelson78]

Glad to hear it's working, but I've no idea why you got that error before.

It is not.

Trying a number of times, if the quantity of records is over a certain threshold, it doesn't work (it deletes everything except the header row).

 

[Fluff]

I've just tested on over 843,000 rows & it works fine for me.
Are you sure that the autofilter is being removed?

 

[Nelson78]

I've just tested on over 843,000 rows & it works fine for me.
Are you sure that the autofilter is being removed?

I've been doing experiments with 135k rows, 12,8 MB.
Like I've said, it removes everything except the header row.

 

[Fluff]

Without access to your file I don't know why that is happening (assuming that you have cells that start with code).

 

[MARK858]

Is your version of Excel before Excel 2010?

I saved again in .xls format

Is it still in .xls format (I don't see how it could be but have to ask)?

 

[Nelson78]

Without access to your file I don't know why that is happening (assuming that you have cells that start with code).

This way seems to work fine (sorting before for alphabetical order).

Consider:
- I've been working with xls 2007
- doing the operation manually, this alert comes up blocking the process: "Microsoft Office Excel cannot create or use the data range reference because it is too complex.Try one or more of the following: ..."

Sub delete_no_cocd()

Worksheets(1).Range("R1") = Now

Dim UsdRws As Long
    UsdRws = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row

Worksheets(1).Sort.SortFields.Clear
Worksheets(1).Sort.SortFields.Add Key:=Range( _
        "H2:H" & UsdRws), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

    With Worksheets(1).Sort
        .SetRange Range("A1:P" & UsdRws)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


   With Worksheets(1)
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:H" & UsdRws).AutoFilter 8, "<>code*"
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
   End With

Worksheets(1).Range("S1") = Now

End Sub

 

[Nelson78]

Is your version of Excel before Excel 2010?



Is it still in .xls format (I don't see how it could be but have to ask)?

No, sorry, I wasn't clear enough: saving again, of course now is in .xlsm.

It is Excel 2007.

 

[MARK858]

I seem to remember that there was an issue with 2007 (similar to the old SpecialCells issue) that was remedied in 2010 which is why I asked if your version was below 2010.
When I am home I will see if I can find anything on it as because sorting seems to to have cured the issue it seems that might well be the issue.