why the code is slow despite of using advanced filter with simple data

[abdelfattah]

Hello,
I don't know why the code is slow using advanced filter despite of my data is not big !
what happens if the data big , what if happens then?!
the code should filter data based on each month in J2 cell

Sub test()
    Dim myMonths, x, r As Range, temp
    myMonths = "janfebmaraprmayjunjulaugsepoctnovdec"
    With Sheets("data")
        Set r = .[k1:k2]
        temp = r.Value: r.ClearContents
        x = Fix(InStr(1, myMonths, .[j2], 1) / 3 + 1)
        If x < 1 Then
            MsgBox "Invalid Entry", , .[j2]: Exit Sub
        Else
            If Sheets("result").Evaluate("count(if(month(a:a)=" & x & ",a:a))") Then
                MsgBox .[j2] & " is already filtered": Exit Sub
            End If
        End If
        r(2).Formula = "=month(a2)=" & x
        With .Cells(1).CurrentRegion
            .AdvancedFilter 1, r
            .Offset(1).Copy _
            Sheets("result").Range("a" & Rows.Count).End(xlUp)(2)
        End With
        If .FilterMode Then .ShowAllData
        r.Value = temp
    End With
End Sub

COPY FILTERD MONTH.xlsm
	A	B	C	D	E	F	G	H	I	J
1	CODE	ITEM	TYPE	ORIGIN	Q					SEARCH
2	01/03/2020	VB23	VBG	JHGFF	100.000					MAR
3	10/05/2020	BN12	FDS	MMM	10.000
4	11/03/2020	CV69	JKI	VV	20.000
5	22/03/2020	AQ2	KJJ	NN	30.000
6	11/08/2020	YU12	BNB	DD	30.000
7	30/06/2020	YU13	BNB	DD	31.000
DATA

Cells with Data Validation
Cell	Allow	Criteria
B2	Custom	=ISERROR(SEARCH("above";E7))

result when write month in J2 then will copy to the bottom in result sheet.

COPY FILTERD MONTH.xlsm
	A	B	C	D	E
1	CODE	ITEM	TYPE	ORIGIN	Q
2	01/03/2020	VB23	VBG	JHGFF	100.000
3	11/03/2020	CV69	JKI	VV	20.000
4	22/03/2020	AQ2	KJJ	NN	30.000
RESULT

Cells with Data Validation
Cell	Allow	Criteria
B2	Custom	=ISERROR(SEARCH("above";E7))

I use advanced filter without loop should really fats that what I think.
I hope to experts help me to find efficient way using advanced filter to make fast and deal with big data(could be 20000 rows in DATA sheet).

 

[DanteAmor]

You are applying an array formula to the entire column. You could limit it to only the range that contains data:
You can also use the classic screenupdating = false

Sub test()
    Dim myMonths, x, r As Range, temp
    Dim lr As Long
    
    myMonths = "janfebmaraprmayjunjulaugsepoctnovdec"
    With Sheets("data")
        Set r = .[k1:k2]
        temp = r.Value: r.ClearContents
        x = Fix(InStr(1, myMonths, .[j2], 1) / 3 + 1)
        If x < 1 Then
            MsgBox "Invalid Entry", , .[j2]: Exit Sub
        Else
          lr = Sheets("result").Range("A" & Rows.Count).End(3).Row
            If Sheets("result").Evaluate("count(if(month(a1:a" & lr & ")=" & x & ",1))") Then
                MsgBox .[j2] & " is already filtered": Exit Sub
            End If
        End If
    
        Application.ScreenUpdating = False
        
        r(2).Formula = "=month(a2)=" & x
        With .Cells(1).CurrentRegion
            .AdvancedFilter 1, r
            .Offset(1).Copy _
            Sheets("result").Range("a" & Rows.Count).End(xlUp)(2)
        End With
        If .FilterMode Then .ShowAllData
        r.Value = temp
        
        Application.ScreenUpdating = False
    End With
End Sub

 

[DanteAmor]

Another option with autofilter to know if the month exists

Sub test_2()
    Dim myMonths, x, r As Range, temp
    Dim lr As Long, n As Long
    Dim shR As Worksheet
    
    Application.ScreenUpdating = False
    
    Set shR = Sheets("result")
    
    myMonths = "janfebmaraprmayjunjulaugsepoctnovdec"
    With Sheets("data")
        Set r = .[k1:k2]
        temp = r.Value: r.ClearContents
        x = Fix(InStr(1, myMonths, .[j2], 1) / 3 + 1)
        If x < 1 Then
            MsgBox "Invalid Entry", , .[j2]: Exit Sub
        Else
          lr = shR.Range("A" & Rows.Count).End(3).Row
          n = 20 + x
          shR.Range("A1:E" & lr).AutoFilter 1, n, 11, 0, , 0
          lr = shR.Range("A" & Rows.Count).End(3).Row
          shR.ShowAllData
          If lr > 1 Then
              MsgBox .[j2] & " is already filtered"
              Application.ScreenUpdating = False
              Exit Sub
          End If
        End If
    
        
        r(2).Formula = "=month(a2)=" & x
        With .Cells(1).CurrentRegion
            .AdvancedFilter 1, r
            .Offset(1).Copy _
            Sheets("result").Range("a" & Rows.Count).End(xlUp)(2)
        End With
        If .FilterMode Then .ShowAllData
        r.Value = temp
        
        Application.ScreenUpdating = False
    End With
End Sub

 

[abdelfattah]

Hi Dante ,
this is really better .!
by the way the second code show me compile error in this word AutoFilter in this line

shR.Range("A1:E" & lr).AutoFilter 1, n, 11, 0, , 0

 

[DanteAmor]

Hi Dante ,
this is really better .!
by the way the second code show me compile error in this word AutoFilter in this line

shR.Range("A1:E" & lr).AutoFilter 1, n, 11, 0, , 0

It was another option, it works for me.
But we are left with post #2

 

[MARK858]

by the way the second code show me compile error in this word AutoFilter in this line

Do you have a sub called AutoFilter?

 

[abdelfattah]

Do you have a sub called AutoFilter?

what do you mean?
you mean I have another macro called AutoFilter?
if it's so no I don't any have another macro except what I got by Dante.moreover I create new workbook and the problem is still continuing .

this is the error.

if you see this is strange case and you interest then I will upload file.

 

[MARK858]

what do you mean?
you mean I have another macro called AutoFilter?

Yes, that was exactly what I meant. Asked because I also don't get an issue with that line, and that error is common when you name a sub or a variable the same as a method or property VBA uses

 

[abdelfattah]

so the version could cause the problem?
I work for 2010
tomorrow I will work for 2016 at work to see what happens.

 

[MARK858]

The version shouldn't be an issue but give it a go