Advance Filter Macro

[Negi1984]

Hi All,

I have data in below format :-
Now I want to add a filter as below mentioned criteria :-

1) Picklisted : Should be New
2) 410(A) : Should remove latest 6 dates from filter
3) GR1 : Should be False
4) GR01 : Should be select all numbers & numbers where 2 numbers mentioned with text Rej.

I tried by myself with without macro with advance filter , but unable to found any solution, how to filter out latest 6 dates from filter. Please assist.

State	Program	Picklisted	410 (A)	GRO1	GR1
0	A	New	7-Aug-13	2334	FALSE
NSW	B	Old site	24-Jul-13	2442	FALSE
NSW	C	New	21-Oct-15	3444	TRUE
NSW	D	New	15-Jan-15	2345	FALSE
NSW	E	Old site	3-Sep-15	5223	FALSE
0	G	New	11-Jun-14	71,74 Rej	FALSE
QLD	D	Old site	29-Aug-13	4555	TRUE
QLD	S	New	20-Sep-13	31,74, Rej	FALSE
QLD	SS	Old site	15-Jul-13	7470	FALSE
QLD	ER	Old site	16-Jul-13	7470	FALSE
WA	4	New	17-Sep-13	74,Rej	FALSE
WA	56	Old site	12-Aug-13	7470	TRUE

<tbody>
</tbody><colgroup><col><col><col><col><col><col></colgroup>

 

[Marcelo Branco]

Rajender,

Delete the previous version of the function EvalCell and paste this new version

Function EvalCell(r As Range)
    Dim spl As Variant, i As Long, lCounter As Long
    
    If Application.IsNumber(r.Value) Then
        EvalCell = "Y"
    ElseIf InStr(1, r.Value, "Rejected", vbTextCompare) > 0 Then
            spl = Split(Application.Trim(Replace(Replace(Replace(r, "-", " "), ",", " "), "Rejected", "")))
            For i = LBound(spl) To UBound(spl)
                If IsNumeric(spl(i)) Then lCounter = lCounter + 1
            Next i
            If lCounter > 1 Then
                EvalCell = "Y"
            Else
                EvalCell = "N"
            End If
    Else
            EvalCell = "N"
    End If
End Function

Hope this works ray:

M.

 

[Marcelo Branco]

Use the code in post 19 to run the macro AdvFilter with the function EvalCell above (new version)

M.

 

[Negi1984]

Use the code in post 19 to run the macro AdvFilter with the function EvalCell above (new version)

M.

Thanks a ton Marcelo, its all working fine now . I will try to learn , how it works.
Have a nice day to you.

Regards,
Rajender

 

[Marcelo Branco]

Thanks a ton Marcelo, its all working fine now . I will try to learn , how it works.
Have a nice day to you.

Regards,
Rajender

You are very welcome. Glad to help

M.