CODEWITHSUNDEEP
vbaexcelexcel-2003
nclfrk799
nclfrk799

Reputation: 35

(Excel 2003 VBA) Delete entire rows based on multiple conditions in a column

I have an interesting issue. I've tried searching this site and Google but there are only slightly related problems, none which actually address this specific need.

I have a spreadsheet with 10 columns (let's call them A-J). I need to delete all the rows that do NOT have a value of "30", "60", "90", "120" or blank within the cells of column H.

Though there are many ways of doing this, all of them have relied on loops, which doesn't work for me as this dataset has over 25k rows and it takes 10+ minutes to run - too long.

I've been looking at autofilter options in conjunction with the .Find function (e.g. find all rows with H cells that don't meet the criteria and delete) but AutoFilter on 2003 only works with 2 criteria, while I have 5 to check against. I'm not sure how to proceed.

Any help is appreciated.

Upvotes: 1

Views: 5448

Answers (5)

nclfrk799
nclfrk799

Reputation: 35

Thanks to all who've suggested solutions. In the between time I ended up figuring out a way to do this in <1 second - apparently I myself didn't realise that AutoFilter could've supported comparison criteria (greater than, less than etc).

Using a series of autofilters I simply filtered for, then deleted all rows that filtered to "<30", "30120".

Not elegant, but it did the trick.

Upvotes: 0

LS_ᴅᴇᴠ
LS_ᴅᴇᴠ

Reputation: 11151

Some speed tips:

  1. When using large data, assign values to array and use array instead of *.Value;
  2. When working with full columns, ignore empty columns at bottom;
  3. When making intensive changes in worksheet, disable screen update and automatic calculation.

Stating this, I would use this code:

Sub Macro1()
    Dim su As Boolean, cm As XlCalculation
    Dim r As Long, v(), r_offset As Long

    su = Application.ScreenUpdating
    Application.ScreenUpdating = False 'Disable screen updating
    cm = Application.Calculation
    Application.Calculation = xlCalculationManual 'Disable automatic calculation

    'Only use used values
    With Intersect(Range("H:H"), Range("H:H").Worksheet.UsedRange)
        v = .Value 'Assign values to array
        r_offset = .Row - LBound(v) 'Mapping between array first index and worksheet row number
    End With

    'Check all row from bottom (so don't need to deal with row number changes after deletion)
    For r = UBound(v) To LBound(v) Step -1
        Select Case v(r, 1)
        Case "30", "60", "90", "120", Empty 'Do nothing
        Case Else
            Sheet1.Rows(r + r_offset).EntireRow.Delete
        End Select
    Next
    Application.ScreenUpdating = su 'Restore screen updating
    Application.Calculation = cm 'Restore calculation mode
End Sub

Upvotes: 0

d-stroyer
d-stroyer

Reputation: 2706

You can add a column with the condition of your own:

=IF(OR(H1=30;H1=60;H1=90;H1=120;H1="");"DELETE";"")

(the formula is given for row 1, you have to copy-paste it to the entire range)

Then use filtering and sorting to select the rows to delete.

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166296

This deleted all matching rows (~10%) in a sample of 25k rows in 20sec

Sub tt()

Dim rw As Range
Dim all As Range
Dim t
Dim b As Boolean

t = Timer
For Each rw In Range("A1").CurrentRegion.Rows

    If rw.Cells(8).Value < 1 Then

        If b Then
            Set all = Application.Union(rw, all)
        Else
            Set all = rw
            b = True
        End If

    End If

Next rw

If not all is nothing then all.EntireRow.Delete

Debug.Print "elapsed: " & Timer - t

End Sub

Upvotes: 2

rangan
rangan

Reputation: 1

You can try Advanced Filter option where you can give more than two criteria to filter the list. After filtering the list matching the criteria you set, the filtered list can be copied to another location (option available) and the remaining deleted.

Upvotes: 0

Related Questions