Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA to conditionally delete rows - need faster method

Status
Not open for further replies.

kskinne

Technical User
Oct 8, 2004
169
0
0
US
I have some code containing a for next loop, which loops through the rows in my range in reverse from bottom to top, and conditionally deletes entire rows from my range, if condition 1, 2, 3, 4 or 5 are true. There is about 4,000 rows in my range of data. This section of the code is taking about 10 minutes to run, and I need to speed things up. Here is the pertinent section of code:

Code:
For i = LastRow To 3 Step -1
  If (Cells(i, 4).Value <> "Broadband Service" And Cells(i, 4).Value <> "Business Service" And Cells(i, 4).Value <> "Residential Service" And Cells(i, 4).Value <> "Video Service") _
  Or (Cells(i, 8).Value = "Upgrade" And (Cells(i, 18).Value = True Or Cells(i, 4).Value <> "Broadband Service")) _
  Or ((Cells(i, 4).Value = "Business Service" Or Cells(i, 4).Value = "Residential Service") And (Cells(i, 5).Value <> "ACCMLB" And Cells(i, 5).Value <> "ACCRES" And Cells(i, 5).Value <> "ACCSLB")) _
  Or (Cells(i, 4).Value = "Broadband Service" And (Left(Cells(i, 5).Value, 3) <> "HSI" Or Cells(i, 5).Value = "HSICRED" Or Cells(i, 5).Value = "HSI100CR" Or Cells(i, 5).Value = "HSIEMP" Or Cells(i, 5).Value = "HSIINST") _
  Or (Cells(i, 4).Value = "Video Service" And (Cells(i, 5).Value <> "BASIC" And Cells(i, 5).Value <> "DTVEXPAND" And Cells(i, 5).Value <> "DTVEXPANDUP" And Cells(i, 5).Value <> "DTVLOCALPLUS") _
  Then Cells(i, 4).EntireRow.Delete
Next

Is there a faster way to accomplish the same thing without looping through each row individually?

Thanks,
Kevin
 
I was actually able to find what I think is a good solution to this problem in another discussion forum. Here is the updated code, which sets a range of just the rows that meet the needed conditions, then deletes that range, leaving behind the remaining rows:

Code:
For i = LastRow To 3 Step -1
  If (Cells(i, 4).Value <> "Broadband Service" And Cells(i, 4).Value <> "Business Service" And Cells(i, 4).Value <> "Residential Service" And Cells(i, 4).Value <> "Video Service") _
  Or Cells(i, 8).Value = "Upgrade" And (Cells(i, 18).Value = True Or Cells(i, 4).Value <> "Broadband Service") _
  Or (Cells(i, 4).Value = "Business Service" Or Cells(i, 4).Value = "Residential Service") And (Cells(i, 5).Value <> "ACCMLB" And Cells(i, 5).Value <> "ACCRES" And Cells(i, 5).Value <> "ACCSLB") _
  Or Cells(i, 4).Value = "Broadband Service" And (Left(Cells(i, 5).Value, 3) <> "HSI" Or Cells(i, 5).Value = "HSICRED" Or Cells(i, 5).Value = "HSI100CR" Or Cells(i, 5).Value = "HSIEMP" Or Cells(i, 5).Value = "HSIINST" Or Left(Cells(i, 5).Value, 4) = "HSIL") _
  Or Cells(i, 4).Value = "Video Service" And (Cells(i, 5).Value <> "BASIC" And Cells(i, 5).Value <> "DTVEXPAND" And Cells(i, 5).Value <> "DTVEXPANDUP" And Cells(i, 5).Value <> "DTVLOCALPLUS" And Cells(i, 5).Value <> "DTVLOCALPLUSUP" And Cells(i, 5).Value <> "DTVSUPREME" And Cells(i, 5).Value <> "DTVSUPREMEUP" And Cells(i, 5).Value <> "RFOVERLAY") _
  Then If rng Is Nothing Then Set rng = Cells(i, 4) Else Set rng = Union(rng, Cells(i, 4))
Next

If Not rng Is Nothing Then rng.EntireRow.Delete

Thanks,
Kevin
 
I would create my own UDF where I can pass a few parameters (values from columns 4, 5, 8, and 18) and return a string of either 'Delete' or 'Keep', use a helper column to evaluate my parameters, and then filter this column and delete all rows with 'Delete'.

Just a suggestion.... :)


---- Andy

There is a great need for a sarcasm font.
 
There'a a lot of referring to the sheet in those macro snippets, it might be worth trying something along these lines (I can't test easily):
Code:
Dim Rng As Range
Set myRng = Range("A1:R" & LastRow)
rngVals = myRng.Value
For i = 3 To LastRow
  If (rngVals(i, 4) <> "Broadband Service" And rngVals(i, 4) <> "Business Service" And rngVals(i, 4) <> "Residential Service" And rngVals(i, 4) <> "Video Service") _
  Or rngVals(i, 8) = "Upgrade" And (rngVals(i, 18) = True Or rngVals(i, 4) <> "Broadband Service") _
  Or (rngVals(i, 4) = "Business Service" Or rngVals(i, 4) = "Residential Service") And (rngVals(i, 5) <> "ACCMLB" And rngVals(i, 5) <> "ACCRES" And rngVals(i, 5) <> "ACCSLB") _
  Or rngVals(i, 4) = "Broadband Service" And (Left(rngVals(i, 5), 3) <> "HSI" Or rngVals(i, 5) = "HSICRED" Or rngVals(i, 5) = "HSI100CR" Or rngVals(i, 5) = "HSIEMP" Or rngVals(i, 5) = "HSIINST" Or Left(rngVals(i, 5), 4) = "HSIL") _
  Or rngVals(i, 4) = "Video Service" And (rngVals(i, 5) <> "BASIC" And rngVals(i, 5) <> "DTVEXPAND" And rngVals(i, 5) <> "DTVEXPANDUP" And rngVals(i, 5) <> "DTVLOCALPLUS" And rngVals(i, 5) <> "DTVLOCALPLUSUP" And rngVals(i, 5) <> "DTVSUPREME" And rngVals(i, 5) <> "DTVSUPREMEUP" And rngVals(i, 5) <> "RFOVERLAY") _
  Then If Rng Is Nothing Then Set Rng = Cells(i, 4) Else Set Rng = Union(Rng, Cells(i, 4))
Next i

If Not Rng Is Nothing Then Rng.EntireRow.Delete
 
kskinne,

If you check back here, did any of the posts get you headed in the right direction? Did you work out or find a solution? Would be nice to see a follow-up at least giving a clue as to what you ended up doing if anything.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
You ought to be able to put an AutoFilter on your table to make visible the rows you want to delete.

Then Select the visible rows and Delete in one operation, without a loop.

Once you have perfected your filter selections, turn on your macro recorder and record...
1) turning on the filter,
2) making the filter selections,
3) selecting the visible rows,
4) deleting the selection and
5) clearing all filters (show all data in your table)

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top