Here is Another version, which will Return Value or Formula ,
Note: Using Rand(), RandBetween(),Now() etc ,can give different Result.
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)).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




Reply With Quote
Bookmarks