• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA - loop through a range of cells, delete rows that match a set of criterias

C

cacos

Member
Hi everyone!


Some time ago SirJB helped me with this code to loop through 2 columns of text and delete the rows whenever a certain criteria is met.


I'm facing a new challenge now, I want it to search for several words, like 200, and delete the row whenever any of those words appear. Also, it needs to be case sensitive.


Here's the code from last time:

[pre]
Code: 
Sub Test()
Dim rng As Range
Dim I As Long, J As Integer
Set rng = Worksheets("Hoja1").[A1:B10]
With rng
For I = .Rows.Count To 1 Step -1
For J = 1 To .Columns.Count
If .Cells(I, J).Value = "House" Then
.Cells(I, J).EntireRow.Delete xlUp
Exit For
End If
Next J
Next I
End With
Set rng = Nothing
End Sub
[/pre]

The criteria in the example above is "House", but I'd need it to search for a lot more words, and whenever any of these words show up, delete the whole row.


I could add endless "OR"s in there, but I'm affraid it'd make it impossible to run.


I really appreciate your help.


Thanks!!
 
[pre]
Code: 
Option Explicit

Sub Test()
Dim rng As Range
Dim I As Long, J As Integer
Dim myCell As Range
Set rng = Worksheets("Hoja1").[A1:B10]
With rng
For I = .Rows.Count To 1 Step -1
For J = 1 To .Columns.Count
For Each myCell In Worksheets("MySheet").Range("A1:A200") 'Add your range here
If .Cells(I, J).Value = myCell Then
.Cells(I, J).EntireRow.Delete xlUp
Exit For
End If
Next
Next J
Next I
End With
Set rng = Nothing
End Sub
[/pre]
 
Hi


I would go at this a bit differently, avoid a lot of the looping gear and zap all at once. Data on Sheet1 and the List of data to remove on Sheet2. Oh I have included headers in my attached example, mmmm headers, very important they are.

[pre]
Code: 
Option Explicit
Sub FilterMulti() 'Dynamic values stored in Cells
Dim i As Integer
Dim ar(1 To 200) As String 'Change to Suit

For i = 1 To 200 'Start in Row 2
ar(i) = Sheet2.Range("A" & i + 1)
Next i

Sheet1.[A1:B10].AutoFilter 1, ar, xlFilterValues
Sheet1.[A2:A10].EntireRow.Delete
Sheet1.[a1].AutoFilter 'Turn Filter Off

Sheet1.[A1:B10].AutoFilter 2, ar, xlFilterValues
Sheet1.[A2:A10].EntireRow.Delete
Sheet1.[a1].AutoFilter 'Turn Filter Off

End Sub
[/pre]

File attached to show workings.


http://rapidshare.com/files/3226112498/FilterMulti.xlsm


Take care


Smallman
 
@Narayan: the list will be in a range, for example A1:A200.


@Hui: It's perfect! The only thing that it's case insensitive, but works OK.


@Smallman: I think you nailed it, case sensitive, fast and so far it's working perfectly.


Thanks everyone for your help!
 
Cacos


Thanks for the feedback. My method boxes your 200 criteria up into an array and filters the array in one hit, then deletes everything. There are 200 iterations to get the data into the array. With a looping construct if none of the items are in your list you will need 8000 loops (10 * 200 * 2). This is the reason this method adds speed to your procedure. It gets relatively faster the longer the list.


Have a read of this. It is gold dust.


http://www.ozgrid.com/forum/showthread.php?t=177019


Point 7 on the vba part is my fav.


Take care


Smallman
 
Smallman, it's better than gold dust. It's fairy dust. A liberal sprinkling of those tips will make code fly.
 
Good stuff Jeff. Thanks for your kind comments. Sprinkle those tips with a Baptism of Pure Fire from a certain member and you come out the other end with some handy knowledge. The above method is particularly effective. Have a good weekend : )
 
Of course, can also do manually by array entering this in C2 and then filtering on TRUE and deleting:

=OR(A2=list,B2=list)
 
Mmmmmm that is a very good point Jeff. I had never thought of approaching the problem like that. It shortens the code which I love. Well done.


So the code for the lazy man is;

[pre]
Code: 
Sub TestoChango()
[C2].FormulaArray = "=OR(A2=List,B2=List)"
[C2].Copy [c3:c11]
[c1:C11].AutoFilter 1, "True"
[c2:C11].EntireRow.Delete
End Sub
[/pre]

Make a named range called List for the values you wish to remove. Make sure there is a header in cell C1.


Take care


Smallman
 
One more code

[pre]
Code: 
Public Sub Code2()
With Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
.Formula = "=IF(AND(ISNA(VLOOKUP(A2,List,1,0)),ISNA(VLOOKUP(B2,List,1,0))),"""",NA())"
.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
.Value = .Value
End With
End Sub
[/pre]
 
I agree. Very cool. Although I like Smallmans in terms of simplicity the best. No mucking about with the spreadsheet, just directly leveraging the filter. Nice.
 
Hey Jeff


Of course you like 'my concept' you came up with it. I just did the easy part. Actually to be honest I didn't think this sort of problem could be cracked without a Loop. Just amazes me what people can come up with at times.


Problem sorted in 4 lines although I can see from Shrivallabha's formula that it could be shortened to 3 lines if he took the With Statement out. Taking that further if you were happy for the formulas to stay in place after the procedure it is only 2 lines. No way!!!! Well done!!!


Smallman
 
Thanks all for your kind words.


As it turns out it was rule number 7 from golden rules list.


It comes with a limitation though in 2K7 and pre versions.

http://www.excelguru.ca/blog/2009/07/23/excel-2010-finally-fixes-specialcells-8192-limit/
 
For those interested:


I ran each of the above codes 4 times

the code was adjusted to have the same ranges in each case


Test

'Seconds 0.519846

'Seconds 0.511130

'Seconds 0.513052

'Seconds 0.515219

Average 0.51481175


FilterMulti

'Seconds 0.009426

'Seconds 0.009635

'Seconds 0.009005

'Seconds 0.010058

Average 0.009531


TestoChango

'Seconds 0.082852

'Seconds 0.063106

'Seconds 0.078972

'Seconds 0.065156

Average 0.0725215


Code2

'Seconds 0.037166

'Seconds 0.028842

'Seconds 0.021904

'Seconds 0.019925

Average 0.02695925


So the FilterMulti code was slightly faster than the Code2 code and was approximately 54 times faster than the Test code


ps: Timing was done using Daniel Ferry's Micro Second accurate timing code.
 
Nice touch, Hui.


I'd think the difference is due to Calculation time [formula implementation]. It will be starker as the range will grow up in size so plain Autofilter is way to go in this case.


Within formulas, it looks like Array formula adds some more calculation load but it is plain guess[don't have anything to corroborate this] as otherwise there's not much that separates our codes.
 
You can even avoid the first loop.

[pre]
Code: 
Dim ar
ar = Sheet2.Range("a2", Sheet2.Range("a" & Sheet2.Rows.Count).End(xlUp))
ar = Application.Transpose(ar)
ar = Split(Join(ar, ","), ",")
[/pre]

Kris
 
Amazing stuff, I just added testochango to my code to get rid of some more unwanted entries. You guys sure make excel fun. Thank you for all your contributions to the forum. :)
 
That is a very cool hack, Krishnakumar. So I take it the purpose of Split(Join(ar, ","), ",") is to turn any numbers into strings?
 
This is just for FYI


The following Hybid between my use of the filter and Kris’s non looping array which by passes the use of a loop to push the data into an array should be pretty efficient. It is more lines of code but should in theory run faster than my prior attempt – TimeKeeper?

[pre]
Code: 
Option Explicit
Sub FilterMulti2()
Dim ar
ar = Sheet2.Range("a2", Sheet2.Range("a" & Sheet2.Rows.Count).End(xlUp))
ar = Application.Transpose(ar)
ar = Split(Join(ar, ","), ",")

Sheet1.[A1:B10].AutoFilter 1, ar, xlFilterValues
Sheet1.[A2:A10].EntireRow.Delete
Sheet1.[a1].AutoFilter 'Turn Filter Off

Sheet1.[A1:B10].AutoFilter 2, ar, xlFilterValues
Sheet1.[A2:A10].EntireRow.Delete
Sheet1.[B1].AutoFilter 'Turn Filter Off
End Sub
[/pre]

Take care


Smalman
 
This:

[pre]
Code: 
Dim ar
ar = Sheet2.Range("a2", Sheet2.Range("a" & Sheet2.Rows.Count).End(xlUp))
ar = Application.Transpose(ar)
ar = Split(Join(ar, ","), ",")
can be achieved with


Dim ar
ar = Evaluate("TRANSPOSE('" & Sheet2.Name & "'!A2:A" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row & ")")
[/pre]
Note: The first one is 0 based array while the second one is 1 based array.
 
You must log in or register to reply here.
Back
Top