Exclude Contents From List :

[Rajan_Verma]

Rajan Verma has posted the following on 10-04-2012 10:14 PM:

Hi, What would be your approach to do this job * Suppose you have 2 List As showing below , and you need to remove List2 contents from List 1 , here is better code to accomplish this job , By using dictionary i just tried to make this process fast Sub ExcludeFromList() * *** […]http://stats.wordpress.com/b.gif?host=excelpoweruser.wordpress.com&blog=38153 515&post=446&subd=excelpoweruser&ref=&feed=1

Exclude Contents From List : (http://excelpoweruser.wordpress.com/2012/10/04/exclude-contents-from-list/)

[Rick Rothstein]

I created a list of the seven continents spread down 10000 rows and then created a list of three of them to be removed. My tests showed the shorter code below (containing about half as many activce lines of code as your routine) executes quicker that the dictionary method you posted. I would note, though, that we are talking about the difference between super-quick and even more super-quick... the user would never be able to tell the difference in speeds of our codes by simple observation. I would also note that I used the same Defined Names ranges as you did for identifying the beginning of the lists.

Sub ExcludeFromList()
Dim X As Long, Index As Long, sRemove As String, vOut As Variant, vList As Variant
Index = 1
vList = Range("rngRange").CurrentRegion
ReDim vOut(1 To UBound(vList), 1 To 1)
sRemove = Chr(1) & Mid(Join(Application.Transpose(Range("MapDelete"). _
CurrentRegion.Value), Chr(1)), Len(Range("MapDelete")) + 1) & Chr(1)
For X = 2 To UBound(vList)
If InStr(sRemove, Chr(1) & vList(X, 1) & Chr(1)) = 0 Then
Index = Index + 1
vOut(Index, 1) = vList(X, 1)
End If
Next
Range("rngRange").CurrentRegion = vOut
End Sub
Note: I assumed the same Defined Names ranges as you did.

[snb]

What about:


Sub M_snb()
sn = Range("B1:B3")
For Each it In sn
Columns(1).Replace it, "", 1
Next
End Sub


Sub M_snb()
sn = Range("B1:B3")
For Each it In sn
Columns(1).Replace it, "", 1
Next
columns(1).specialcells(4).entirerow.delete
End Sub

[Rick Rothstein]

What about:


Sub M_snb()
sn = Range("B1:B3")
For Each it In sn
Columns(1).Replace it, "", 1
Next
End Sub

On my computer, my code executes in 0.02 seconds on average where as Rajan's executes in 0.03 seconds on average... the code you posted executes in 0.03 seconds on average; HOWEVER the list your code produces is not the same as the list Rajan's and my code produce. The list your code produces is littered with blank cells whereas our list have no blank cells in them. If I add this line of code to your code...

Columns(1).SpecialCells(xlBlanks).Delete xlShiftUp

in order to "squeeze out" the blank cells, the code's time balloons to just under 2.5 seconds.

[snb]

I posted an amendment earlier.

Another approach:

Sub M_snb()
[A1:A1000] = [if(A1:A1000=B1,"",if(A1:A1000=B2,"",if(A1:A1000=B3,"",A1:A1000)))]
Columns(1).SpecialCells(4).Delete
End Sub


EDIT NOTE FROM RICK ROTHSTEIN
-------------------------------------
Sorry, but I accidentally edited (instead of replying) to your message. I think I put it back the way you had it, but if not, I apologize.

[Rick Rothstein]

I posted an amendment earlier.

Another approach:

Sub M_snb()
[A1:A1000] = [if(A1:A1000=B1,"",if(A1:A1000=B2,"",if(A1:A1000=B3,"",A1:A1000)))]
Columns(1).SpecialCells(4).Delete
End Sub
I corrected your last row number to 10002 to match the setup I used for the other tests... your code above executes in 0.36 seconds on average. An interesting side note... I originally had a backup copy of my lists in Columns J and K (so I could perform the tests against the exact same lists each time) and, because of that, your Delete pulled the data sideways from the left rather than upwards from the bottom. I moved my lists to another sheet before testing your code for this response... just thought I would alert the readers of this thread about the possible problems that can result by relying on default values/settings.

[snb]

or:

Sub M_snb()
sn = Range("B1:B3")
sp = Filter(Filter(Filter(Application.Transpose(Range("A1:A1000")), sn(1, 1), False), sn(2, 1), False), sn(3, 1), False)
Cells(1, 8).Resize(UBound(sp) + 1) = Application.Transpose(sp)
End Sub

or:

Sub M_snb_002()
sn = Range("B1:B3")
sp = Columns(1).SpecialCells(2)

For j = 1 To UBound(sp)
If (sp(j, 1) = sn(1, 1)) + (sp(j, 1) = sn(2, 1)) + (sp(j, 1) = sn(3, 1)) = 0 Then c00 = c00 & "_" & j
Next

sp = Application.Index(sp, Split(Mid(c00, 2), "_"), 1)
Cells(1, 10).Resize(UBound(sp)) = Application.Transpose(sp)
End Sub

Does this amendment make any difference ?


Sub M_snb()
sn = Range("B1:B3")

For Each it In sn
Columns(1).specialcells(2).Replace it, "", 1
Next

columns(1).specialcells(4).entirerow.delete
End Sub

[Rick Rothstein]

Persistence paid off!:applause:

Your first rountine (the one with the three Filter and two Transpose calls) bounces between 0.02 and 0.03 seconds, mostly 0.02, so it matches the speed of my routine using only three active lines of code (eight lines of code less than mine)! Congratulations!:thumbsup: I was a little surprised that those two Transpose calls did not slow things down more; actually, I would have thought the three nested Filter calls might have slowed thing down as well... obviously I would have been wrong. Again, well done. By the way, your other two attempts did not fair anywhere near as well... the second one taking about 0.14 seconds and the last on about 0.85 seconds. Oh, just for information sake, from the list of 10001 continent names, 2820 of them were being deleted.

[snb]

Hi Rick

Thanks for testing !
Would disabling screenupdating and calculation make any difference in the last suggestion (containing 'replace it,"" ' )?

[Rick Rothstein]

Hi Rick

Thanks for testing !
Would disabling screenupdating and calculation make any difference in the last sugestion (containing 'replace it,"" ' )?
No, disabling the screen had no real effect (time-wise)

[snb]

Now using the UI facilities:

Autofilter:

Sub M_snb_003()
sn = Range("B1:B3")

With Columns(1)
.AutoFilter 1, sn(1, 1), xlOr, sn(2, 1)
.SpecialCells(12).Delete xlShiftUp
.AutoFilter
.AutoFilter 1, sn(3, 1)
.SpecialCells(12).Delete xlShiftUp
.AutoFilter
End With
End Sub

and advancedfilter


Sub M_snb_004()
Cells(1, 4).Resize(, 3) = Cells(1, 1).Value
Cells(2, 4).Resize(, 3) = Array("<>" & Cells(1, 2), "<>" & Cells(2, 2), "<>" & Cells(3, 2))
Columns(1).AdvancedFilter 2, Cells(1, 4).CurrentRegion, Cells(1, 12)
End Sub

The criterion range can be filled manually (or only once); after that you can test the speed of avancedfilter.
For simplicity's sake I added the code to fill the criterion range.

[Rick Rothstein]

Now using the UI facilities:

Autofilter:

Sub M_snb_003()
sn = Range("B1:B3")

With Columns(1)
.AutoFilter 1, sn(1, 1), xlOr, sn(2, 1)
.SpecialCells(12).Delete xlShiftUp
.AutoFilter
.AutoFilter 1, sn(3, 1)
.SpecialCells(12).Delete xlShiftUp
.AutoFilter
End With
End Sub

and advancedfilter


Sub M_snb_004()
Cells(1, 4).Resize(, 3) = Cells(1, 1).Value
Cells(2, 4).Resize(, 3) = Array("<>" & Cells(1, 2), "<>" & Cells(2, 2), "<>" & Cells(3, 2))
Columns(1).AdvancedFilter 2, Cells(1, 4).CurrentRegion, Cells(1, 12)
End Sub

The criterion range can be filled manually (or only once); after that you can test the speed of avancedfilter.
For simplicity's sake I added the code to fill the criterion range.
M_snb_003 came in at 1.15 seconds on the first test, so I did not run any more test for it. As for M_snb_004, I am not sure what should be happening, but nothing seems to happen at all. Well, that is not entirely true, the heading for the list of 10001 continent names (List 1 on my worksheet) gets repeated three times in cells D1:F1 and the cell under them show a not equal sign with one of the names from the "delete me" list, but that is all. The list of 10001 continent names does not change and no other text appears on the worksheet. It takes the code 0.03 seconds (consistently) to do only that.

[snb]

@Rick

snb_004 puts the items to be removed in a criterion range D1:F2
It's necessary that column A has a column label/ heading in A1 which doesn't appear in the list A2:A10000
The advancedfilter will write the result into column M.

[Rick Rothstein]

@Rick

snb_004 puts the items to be removed in a criterion range D1:F2
It's necessary that column A has a column label/ heading in A1 which doesn't appear in the list A2:A10000
The advancedfilter will write the result into column M.
Okay, I see what I was doing wrong. Apparently Advanced Filter is the way to go... not sure where my prior 0.03 seconds came from, but now I get a consistent 0.01 seconds for M_snb_004. Excellent time, although if you put in the necesary "clean up" that you did not do (remove the Defined Names you added to the workbook and delete the text you put in cells D1:F2), it might push the time to 0.02 seconds (I did not test for that because even at 0.02 seconds, this is a worthwhile way to code the procedure).

[snb]

@Rick

I didn't add any named ranges to the workbook. The VBA code produces those automatically.
I don't think it's of any use to clean those ranges, they will be overwritten automatically by the next advanced filter operation.

[Rick Rothstein]

@Rick

I didn't add any named ranges to the workbook. The VBA code produces those automatically.

I wasn't aware that Advanced Filter did that... good to know. Thanks... obviously I don't use Advanced Filter very offer (like hardly at all), but given the speeds I am seeing for it, I think maybe I will from now on.



I don't think it's of any use to clean those ranges, they will be overwritten automatically by the next advanced filter operation.
If you had any tendencies toward being obsessive-compulsive, you would.:biggrin:

[snb]

My medication prevents my inclination ;)