Delete List Contain Matching from Second List
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"
Code:
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(VarArrResult)).Value = Application.Transpose(VarArrResult)
Set objDicMap = Nothing
Set rngCell = Nothing
End Sub
Thanks for Reading
Rajan.
