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(VarArrResult)).Value = Application.Transpose(VarArrResult)
    Set objDicMap = Nothing
    Set rngCell = Nothing

End Sub

Thanks for Reading

Rajan.