Optimize loop logical statement in VBA

Question

I wrote this code to delete from a table all rows not containing the word "ITA", "GRE" OR "CHE" in a particular column. Now, the table is big (60k observations) and the loop is obviously time consuming (5-6 minutes). What would be another way of tackling the task in order to optimize the efficiency of the code (i.e. performing the task in 10 to 30 seconds)?

Sub test()

 countrycol = UsedRange.Find("Country", lookat:=xlWhole).Column
 For j = 1 To Cells(Rows.Count, countrycol).End(xlUp).Row

 If UsedRange.Cells(j + 1, countrycol).Value <> "ITA" Or UsedRange.Cells(j + 1, countrycol).Value <> "GRE" _
                                         Or UsedRange.Cells(j + 1, countrycol).Value <> "CHE" Then

 UsedRange.Cells(j + 1, countrycol).EntireRow.Delete

 End If

 Next j
End Sub

For future reference: This is the place for figuring out why broken code isn't working. Functional code that needs to be improved (such as shorter run-time) is a much better fit for [codereview.se]. — FreeMan, Sep 18 '18 at 11:09

score 2 · Answer 1 · answered Sep 18 '18 at 09:18

Create an AutoFilter by building a dictionary of keys that do not belong from an array of the values in the country column. Delete the visible rows.

sub test2()

    dim i as long, arr as variant, m as variant, dict as object

    set dict = createobject("scripting.dictionary")

    with worksheets("All")

        if .autofiltermode then .autofiltermode = false

        m = application.match("country", .rows(1), 0)
        if iserror(m) then exit sub

        arr = .range(.cells(2, m), .cells(.rows.count, m).end(xlup)).value2

        for i = lbound(arr, 1) to ubound(arr, 1)
            select case ucase(arr(i, 1))
                case  "ITA", "GRE", "CHE"
                    'do nothing
                case else
                    dict.item(arr(i, 1)) = arr(i, 1)
            end select
        next i

        with .cells(1, 1).currentregion
            .autofilter field:=m, criteria1:=dict.keys, operator:=xlfiltervalues
            with .resize(.rows.count-1, .columns.count).offset(1, 0)
                if cbool(application.subtotal(103, .cells)) then
                    .specialcells(xlcelltypevisible).entirerow.delete
                end if
            end with
        end with

        .autofiltermode = false

    end with

end sub

Thanks. I tried it, but when I run the macro I get the type mismatch error ( i do not get the error when i step in with F8). I tried to change the variable dim but it seems not working... — Saverio, Sep 18 '18 at 09:36
You didn't catch my minor edit made moments after initial posting. — , Sep 18 '18 at 09:38
Still getting the error type mismatch. Tried to change the dim but it does not work. And, moreover, it does not let me debug into to see where the problem could be — Saverio, Sep 18 '18 at 09:41
Works for me. I guess the sample data I made up isn't the same as yours. Don't worry, I think I can save us both some time. — , Sep 18 '18 at 09:44

Rafał B. · Answer 2 · 2018-09-18T10:00:23.447

I would make it simple (manually or VBA): 1) add 1 temporary column to your table with formula to check if the row should be deleted e.g. "=IF(OR(country="ITA";country="CHE";country="GRE"); "let";"delete"). The temp column will show one of two values: "delete", "let". After that you can change formulas into values to make the process more quick 2) sort table A-Z using temp column 3) in any way search for last row to be deleted e.g.using countif or search. Delete the rows from top to address you just found

Optimize loop logical statement in VBA

2 Answers2

Related