Printable View
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?hos...f=&feed=1
Exclude Contents From List :
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.
Note: I assumed the same Defined Names ranges as you did.Code: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
What about:
Code:Sub M_snb()
sn = Range("B1:B3")
For Each it In sn
Columns(1).Replace it, "", 1
Next
End Sub
Code: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
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...Quote:
Originally Posted by snb
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.
I posted an amendment earlier.
Another approach:
Code: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.
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.Quote:
Originally Posted by snb
or:
or:Code: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
Does this amendment make any difference ?Code: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
Code: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
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.
Hi Rick
Thanks for testing !
Would disabling screenupdating and calculation make any difference in the last suggestion (containing 'replace it,"" ' )?
No, disabling the screen had no real effect (time-wise)Quote:
Originally Posted by snb
Now using the UI facilities:
Autofilter:
and advancedfilterCode: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
The criterion range can be filled manually (or only once); after that you can test the speed of avancedfilter.Code: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
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.Quote:
Originally Posted by 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.
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).Quote:
Originally Posted by 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.
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.Quote:
Originally Posted by snb
If you had any tendencies toward being obsessive-compulsive, you would.:biggrin:Quote:
Originally Posted by snb
My medication prevents my inclination ;)