Filter and Delete - Date to be taken from another sheet

[Niranjanrajrishi]

Sub ProdSel()

    Dim lngStart As Long, lngEnd As Long
    Dim rng As Range
    Sheets("Data").Select
    Range("N2").Select
     
      If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
    Rws = Cells(Rows.Count, "A").End(xlUp).Row
 
    lngStart = Sheets("Macro").Range("K14") 'assume this is the start date
    lngEnd = Sheets("Macro").Range("L14") 'assume this is the end date
    Part1 = Sheets("Macro").Range("J14") 'assume this is the end date
        Columns("A:V").AutoFilter Field:=4, _
        Criteria1:="=" & Part1
 
    Columns("A:V").AutoFilter Field:=11, _
        Criteria1:="=" & lngStart, _
        Operator:=xlAnd, _
        Criteria2:="=" & lngEnd

    Columns("A:V").AutoFilter Field:=4, _
        Criteria1:="=" & Part1

    Sheets("Data").Activate

    Rws = Cells(Rows.Count, "A").End(xlUp).Row

    Set rng = Range(Cells(2, "W"), Cells(Rws, "W")).SpecialCells(xlCellTypeVisible)
      If Not rng Is Nothing Then rng.Value = "Required"
   
    If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
    Rws = Cells(Rows.Count, "A").End(xlUp).Row
 
  ActiveSheet.Range("$A$1:$AP$" & Rws).AutoFilter Field:=42, Criteria1:="", Operator:=xlFilterValues
    Set rng = ActiveSheet.Range("$A$2:$AP$" & Rws).SpecialCells(xlCellTypeVisible)
    If Not rng Is Nothing Then
      Set rng = Nothing
      Set rng = Range(Cells(2, "AP"), Cells(Rws, "AP")).SpecialCells(xlCellTypeVisible)
      If Not rng Is Nothing Then rng.Value = "Delete"
    End If
    With ActiveSheet
    .AutoFilterMode = False
    End With

Hello,

Need support to delete those data which does not match with the Criteria set in the Macro sheet.

Product ID in J column (Macro sheet)
Date from in K column (Macro sheet)
Date from in L column (Macro sheet)

The product IDs will be multiple (maximum 10) and the respective date shoould match in the Data sheet. Any Product ID which does not fall under the date criteria (from Date and To date) should be deleted.

Can you please help me?

 

[Marc L]

Hi !

As a starter :​

Sub Demo0()
         Dim Dic As Object, R&, V, W, D&, L&
         Set Dic = CreateObject("Scripting.Dictionary")
    With Range("Macro!J12").CurrentRegion.Rows
        For R = 3 To .Count
            V = .Item(R).Columns("B:C").Value2
            W = .Cells(R, 1).Value2
            If Dic.Exists(W) Then Dic(W) = Application.Index(Array(Dic(W), V), 0) Else Dic(W) = V
        Next
    End With
         Application.ScreenUpdating = False
    With Worksheets("Data").UsedRange.Columns("A:W").Rows
        For R = 2 To .Count
                V = True
                W = .Cells(R, 4).Value2
            If Dic.Exists(W) Then
                    D = .Cells(R, 11).Value2
                    W = Dic(W)
                For L = 1 To UBound(W)
                    If D >= W(L, 1) And D <= W(L, 2) Then V = False: Exit For
                Next
            End If
               .Cells(R, 23).Value = V
        Next
           .Sort .Cells(23), xlAscending, Header:=xlYes
            V = Application.Match(True, .Columns(23), 0)
            If IsNumeric(V) Then .Item(V & ":" & .Count).Clear
           .Columns(23).Clear
    End With
            Dic.RemoveAll
        Set Dic = Nothing
        Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[YasserKhalil]

Great Mr. Marc
Can you explain this line please

If dic.Exists(w) Then dic(w) = Application.Index(Array(dic(w), v), 0) Else dic(w) = v

How can I follow the dictionary in locals window .. I can just see the items .. How can I use the immediate window to know the contents of the item?

* I used those lines to loop through the keys and that is ok

    Dim key As Variant
    For Each key In dic.Keys
        Debug.Print key
    Next key

But how I can loop through to identify the contents of each key? I am confused about that

 

[Chihiro]

Dictionary item can be accessed using dic(key) or dic.Item(key).

So... to print key item pair.

    For Each key In dic.Keys
        Debug.Print key & ", " & dic(key)
    Next key

 

[YasserKhalil]

Thanks a lot Mr. Chihiro
I make use of that and it worked when items are strings .. but in that case in the Marc's code, the items are arrays so I used something like that before Application.ScreenUpdating=False

    Dim vv, key
    For Each key In dic.Keys
        Debug.Print key
        vv = dic(key)
    Next key

 

[Chihiro]

If it's array that's stored as dictionary item.

For Each Key in dic.Keys
    For i = LBound(dic(Key)) to UBound(dic(Key))
        Debug.Print dic(Key)(i)
    Next
Next

 

[Marc L]

Yes it's arrays stored as items in the dictionary …

The variable V is the dates of columns 2 & 3 of the worksheet Macro
in a row format so 1 row of 2 columns (2 dimensions).
As a same Product Part # can have two pairs of dates so instead
of storing an array of arrays, the Excel worksheet function INDEX joins
for example 2 arrays of one row in a global array of 2 rows
like if the data were directly sorted by part # …

To follow the dictionary watch out the variable V
or the variable W at codeline #18 or in the loop just under
or just adding a Variant variable for the result of the Index function …

To illustrate compare V, W & X in the Locals window :​

Sub TestINDEX()
    V = [{"A","B";1,2}]
    W = Array([{"A","B"}], [{1,2}])
    X = Application.Index(W, 0)
    Stop
End Sub

INDEX is a powerful function as it can also transpose data
from a column to one row for example …
​

 

[Marc L]

Yasser, I just update the code of my previous message …​

​

 

[Niranjanrajrishi]

Hi Marc,

I tried with the coding but it gives me error. I have attached file and could you please check for me? The data might not be available in all columns based on the input. The columns A, B, C, D and K always will have values.

 

[Marc L]

As the demo works a treat on the original attachment
where the column K contains real dates …
With your new attachment this column does not contain any valid date
but just text ! Convert to dates like in sheet Macro or original data
and the demo will work again as expected …
​