Delete List Contain Matching from Second List

[Rajan_Verma]

Hi,

What would be your approach to do this job

Suppose you have 2 List, and you need to remove List2 contents from List1 , here is better code to accomplish this job , By using dictionary i just tried to make this process fast

You just need to define two name ranges to use this Code,

1st Cell of List1 = "RngRange"
1st Cell of List2 ="MapDelete"




Sub ExcludeFromList()

Dim objDicMap As Object
Dim VarArrData
Dim VarArrResult
Dim rngCell As Range
Dim lngCOunt As Long

VarArrData = Intersect(Range(“rngRange”).CurrentRegion, Range(“rngRange”).CurrentRegion.Offset(1))
Set objDicMap = CreateObject(“Scripting.Dictionary”) ‘ Dictionary Object get Mapping

’Filling Dictionary
For Each rngCell In Intersect(Range(“MapDelete”).CurrentRegion, Range(“MapDelete”).CurrentRegion.Offset(1))
If Not objDicMap.exists(rngCell.Value) Then objDicMap.Add rngCell.Value, rngCell.Value
Next rngCell

’Filling Result Array From Data List which would not Include Mapping Data

For lngCOunt = LBound(VarArrData) To UBound(VarArrData)
If Not objDicMap.exists(VarArrData(lngCOunt, 1)) Then
If Not IsArray(VarArrResult) Then
ReDim VarArrResult(0 To 0)
VarArrResult(0) = VarArrData(lngCOunt, 1)
Else
ReDim Preserve VarArrResult(UBound(VarArrResult) + 1)
VarArrResult(UBound(VarArrResult)) = VarArrData(lngCOunt, 1)
End If
End If
Next lngCOunt
‘Clear Old List
Range(“rngRange”).CurrentRegion.Offset(1).Clear
‘Replace with new list
Range(“rngRange”).Offset(1).Resize(UBound(VarArrRe sult)).Value = Application.Transpose(VarArrResult)
Set objDicMap = Nothing
Set rngCell = Nothing

End Sub


Thanks for Reading

Rajan.

[Excel Fox]

Nice one Rajan. One slight problem would be that if the values in the list are not constants, they will all be converted to constants after the macro is run.....

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg (https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1 (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg (https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg)
https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg (https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9 (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I)
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3 (https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
ttps://www.youtube.com/watch?v=LP9fz2DCMBE (ttps://www.youtube.com/watch?v=LP9fz2DCMBE)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8 (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8)
ttps://www.youtube.com/watch?v=bFxnXH4-L1A (ttps://www.youtube.com/watch?v=bFxnXH4-L1A)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg)
ttps://www.youtube.com/watch?v=GqzeFYWjTxI (ttps://www.youtube.com/watch?v=GqzeFYWjTxI)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Rajan_Verma]

Here is Another version, which will Return Value or Formula ,


Note: Using Rand(), RandBetween(),Now() etc ,can give different Result.




Sub ExcludeFromList()

Dim objDicMap As Object
Dim VarArrData
Dim VarArrResult
Dim rngCell As Range
Dim lngCOunt As Long

VarArrData = Intersect(Range("rngRange").CurrentRegion, Range("rngRange").CurrentRegion.Offset(1)).Formula
Set objDicMap = CreateObject("Scripting.Dictionary") ' Dictionary Object get Mapping

'Filling Dictionary
For Each rngCell In Intersect(Range("MapDelete").CurrentRegion, Range("MapDelete").CurrentRegion.Offset(1))
If Not objDicMap.exists(rngCell.Value) Then objDicMap.Add rngCell.Value, rngCell.Value
Next rngCell

'Filling Result Array From Data List which would not Include Mapping Data

For lngCOunt = LBound(VarArrData) To UBound(VarArrData)
If Not objDicMap.exists(Evaluate(VarArrData(lngCOunt, 1))) Then
If Not IsArray(VarArrResult) Then
ReDim VarArrResult(0 To 0)
VarArrResult(0) = VarArrData(lngCOunt, 1)
Else
ReDim Preserve VarArrResult(UBound(VarArrResult) + 1)
VarArrResult(UBound(VarArrResult)) = VarArrData(lngCOunt, 1)
End If
End If
Next lngCOunt
'Clear Old List
Range("rngRange").CurrentRegion.Offset(1).Clear
'Replace with new list
Range("rngRange").Offset(1).Resize(UBound(VarArrResult)).Value = Application.Transpose(VarArrResult)
Set objDicMap = Nothing
Set rngCell = Nothing

End Sub

[Excel Fox]

Nice adaptation.....

[Rajan_Verma]

a formula can also do this :

=IFERROR(INDEX(List1,SMALL(IF(ISNA(MATCH(List1,Lis t2,0)),ROW(INDIRECT("1:" & ROWS(List1))),""),ROW(INDIRECT("1:"&COUNT(IF(ISNA(MATCH(List1,List2,0)),ROW(List1),""))))),1),"")

Looking for a shorter One

Rajan.

[snb]

here you go:

list1: A10:A20
list2: B10:B20


Sub tst()
[A10:A20] = [if(countif(A10:A20,B10:B20)>0,"",A10:A20)]
End Sub


as an arrayformula:


{=IF(COUNTIF(A10:A20;B10:B15)>0,"",A10:A20)}

[Rajan_Verma]

i think your formula is not giving Correct result,

396

is it your result ?

[snb]

Fair enough; in C1:


=IF(COUNTIF($B$1:$B$11;A1)>0;"";A1)
autofill to C11.

[Rajan_Verma]

Hi snb,
your formula is nice.. but we can't have a list without blank cells.

Rajan

[snb]

but we can't have a list without blank cells.

This doesn't make sense to me.

this is how you started this thread:


Suppose you have 2 List, and you need to remove List2 contents from List1


Probably you are looking for:


Sub snb()
sn = Application.Transpose(Filter([transpose(if(countif(B$1:B$3,A1:A12)=0,A1:A12))], "False", False))
cells(1,3).resize(ubound(sn)+1)=sn
End Sub

[Rajan_Verma]

Yes Remove means Remove . not replace them with blanks

[snb]

Sub snb()
sn = Application.Transpose(Filter([transpose(if(countif(B$1:B$3,A1:A12)=0,A1:A12))], False, False))
cells(1,3).resize(ubound(sn)+1)=sn
End Sub

[Rajan_Verma]

Yes.. it nice :)