• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to filter a column with multiple dynamic dates

R

Rmejia

New Member
I have a macro where I can filter x amount of times I want any column of any workbook to show only the activecell value. I have it installed on personal macros so it works with excel instead of any specific workbook meaning it works with all workbooks.
Now I'm trying to create a macro for the opposite. I will like to filter to show everything but the active cell value multiple times with any column. Meaning if i have numbers in a column from 1 to 10 and the activecell is on the cell that has 5, it will show the rows that have 1-4 and 6-10 only and will filterout the rows with a 5 in that column. If I repeat this in another column that has a-z but E is already filtered out due to the first filter, and now the active cell is on N, it will now filter out the Rows with the N and the 5, etc.
I got it to work but what it does is, the first time is very straight forward with one line of code and its working for every type of data on the columns (text, numbers, blanks and dates), but when I try to filter the second time and going forward, the way I was able to do the code was doing a copy and paste of the visible cells to below the range that is used, then it removes duplicates and erases the active cell value from the list and then it does an autofilter with the array of what is left on the list.
That's the only way I was able to do it base on my capabilities with excel.
So far is working for Texts, numbers and blanks, but if there are any dates in the column, it will filter them out everytime even though the active cell is not on one of them.
Does anyone know how can I get what this filter out in another way or how to fix the issue with the dates?
Code: 
Sub FilterOut()
    Dim WS As Worksheet, i As Integer, FilterArray As Variant, Data As Range, D As Long, DatesArray As String
    
    Application.ScreenUpdating = False

    Set WS = ActiveSheet
    On Error Resume Next
        Set Data = ActiveCell.ListObject.Range      'Filter tables
    On Error Resume Next
    If Data Is Nothing Then
        Set Data = ActiveCell.CurrentRegion
    End If
    
    C = ActiveCell.Column
    Del = ActiveCell.Value
    
    If WS.FilterMode = False Then       'Filterout the first time
        If Del = Empty Then             'For Filterout blank cells
            Data.AutoFilter Field:=C, Criteria1:="<>"
        Else
            Data.AutoFilter Field:=C, Criteria1:="<>" & Del
        End If
    Else
        WS.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, C).Select    'Select the first row of the Filtered table, below the Header
        LR = WS.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row     'Get the LR of the filtered Table
        LR2 = WS.UsedRange.Rows(WS.UsedRange.Rows.Count).Row                                'Get the LR of the Original Table
        Range(Selection, Cells(LR, C)).Select                                               'Select all Visible cells in the column
        Selection.SpecialCells(xlCellTypeVisible).Copy                                      'Copy Selection
    
        Cells(LR2 + 5, C).PasteSpecial xlPasteValuesAndNumberFormats                        'Paste 5 rows below the Last Used Cell
        Application.DisplayAlerts = False
        With Selection
            RowsDelete = .Cells.Count                                                       'Know how many rows to delete at the end
            Application.CutCopyMode = False
            .RemoveDuplicates Columns:=1, Header:=xlNo                                      'Remove duplicates from list
            .Replace What:=Del, Replacement:="", lookat:=xlWhole                            'Deletes the ActiveCell Value from list
        
            WS.Sort.SortFields.Clear                                                        'Sort the list to remove empty cells
            WS.Sort.SortFields.Add Key:=Cells(LR2 + 5, C), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
            With WS.Sort
                .SetRange Range("A1:A" & RowsDelete).Offset(LR2 + 4, C - 1)
                .Apply
            End With
            ArrayRows = WorksheetFunction.CountA(.Cells)
            Min = WorksheetFunction.Min(.Cells)
            Max = WorksheetFunction.Max(.Cells)
        
            If Del <> Empty Then                                                'Show also blank cells
                Cells(LR2 + 5 + ArrayRows, C).Value = "="
                FilterArray = Join(Application.Transpose(Range(Cells(LR2 + 5, C), Cells(LR2 + 5 + ArrayRows, C))), ",")
            Else
                FilterArray = Join(Application.Transpose(Range(Cells(LR2 + 5, C), Cells(LR2 + 4 + ArrayRows, C))), ",")
            End If
            FilterArray = Split(FilterArray, ",")

            If Min = 0 Or Min > 60000 Or Max < 1 Then: GoTo NODATE              'Check if there might be Dates on the list
            
            For i = 1 To ArrayRows                                              'Go thru the list
                If IsDate(Cells(LR2 + 4 + i, C).Value) Then                     'Create a different array for dates
                    D = D + 1
                    If D = 1 Then                                               'Add the ( the first time
                        DatesArray = DatesArray & "2,""" & CDate(Cells(LR2 + 4 + i, C).Value) & """"
                    Else
                        DatesArray = DatesArray & ",2,""" & CDate(Cells(LR2 + 4 + i, C).Value) & """"
                    End If
                End If
            Next i
            If D > 1 Then                   'Add ) to the end if there where any dates on the list
                DatesArray = DatesArray & ")"
            End If
NODATE:
        End With
        
        WS.Range(WS.Rows(LR2 + 5), WS.Rows(LR2 + 5 + RowsDelete)).Delete Shift:=xlUp    'Delete the added rows
        
        Application.DisplayAlerts = True
        
        Data.AutoFilter Field:=C, Criteria1:=FilterArray, Operator:=xlFilterValues ', Criteria2:=Array(Split(DatesArray, ",")) 'Filter only the list
        
        WS.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, C).Select            'Select the first cell
    End If
    Application.ScreenUpdating = True
ActiveSheet.UsedRange
End Sub
 
Start to well elaborate what means your title, in particular « dynamic dates » , is it a new Excel feature ?​
As there is nothing in Excel help and as I never has seen such thing !​
​
Just using Excel filters as recommended, just operating manually …​
​
 
I want to use it with any workbook, so the dates cannot be typed, they need to be variables. Imagine a column with birthdays where you have 50 unique dates, you want to remove one of those from the list by filtering that one out. So the other 49 could be any date.
 
So « dynamic dates » are nothing but dates, that's confusing like « multiple » as dates​
so your title should be « How to filter a column with dates » …​
​
When I manually filter a dates column, I can enter the date to not show just respecting a kid level logic, no issue …​
So how do you manually operate ?​
​
 
I search for this already: How to filter a column with dates, and what i found was using between two dates, or typing the dates manually, i want to use variables. But the title is not the problem.

Not understanding your question. Manually i open the filter drop down and unclick the date i don't want to see.
 
Such title can lead some helpers to not open your thread thinking « that seems too difficult » or like me,​
when the title is confusing I guess the initial post is at the same level without all the necessary any forum expects for,​
with nothing to guess, so I won't waste time with such thread to have more time for others threads …​
​
So if it works operating manually on your side it's easy to reproduce the same way under a VBA procedure​
as you can start using the Macro Recorder …​
​
 
when i use the macro recorder it shows this:
Code: 
Sub Macro3()
    ActiveSheet.Range("$A$1:$P$19").AutoFilter Field:=10, Operator:=xlFilterValues, Criteria2:=Array(1, "2/6/2020", 2, "3/4/2020", 1, "5/6/2020")
End Sub

I can create a variable and store the dates exactly as are shown there on the array for the criteria2, but it doesn't work. It does that in this part of the code:
Code: 
For i = 1 To ArrayRows                                              'Go thru the list
                If IsDate(Cells(LR2 + 4 + i, C).Value) Then                     'Create a different array for dates
                    D = D + 1
                    If D = 1 Then                                               'Add the ( the first time
                        DatesArray = DatesArray & "(2,""" & CDate(Cells(LR2 + 4 + i, C).Value) & """"
                    Else
                        DatesArray = DatesArray & ",2,""" & CDate(Cells(LR2 + 4 + i, C).Value) & """"
                    End If
                End If
            Next i
            If D > 1 Then                   'Add ) to the end if there where any dates on the list
                DatesArray = DatesArray & ")"
            End If
 
To update the title edit the initial post with the Edit link at the bottom of the post.​
​
Intead of an array (even if you can use the Filter VBA text function to remove an element from an array)​
why don't you use the obvious filter condition 'different than' ?!​
​
 
Every reply I've sent has that edit button but the initial post, don't know why.

Different than won't work when you have 50 unique dates and you only want to remove one out those.
 
I use different than the for the first time to filter, but it doesn't work the following times because it's going to show the first filter back. I already have different than on the code here:
Code: 
If WS.FilterMode = False Then       'Filterout the first time
        If Del = Empty Then             'For Filterout blank cells
            Data.AutoFilter Field:=C, Criteria1:="<>"
        Else
            Data.AutoFilter Field:=C, Criteria1:="<>" & Del
        End If
    Else
 
You must log in or register to reply here.
Back
Top