VBA Advanced Filter help/ Dynamic Function

[Mallesh23]

Hi Team,

My Code is giving me Correct result, how to achieve same result via advanced filter or Dynamic Function to reduce Code,
In below I have taken only Two Situation there may be 10-15 like this.

A	B	C			Situation 1 , Include all Criteria List		Situation 2 , Exclude Column J List
List1	List2	List3			Criteria List 1	Criteria List 2	Criteria List 3		Criteria List 1(Exclude)	Criteria List 2	Criteria List 3
ZZZ	CCC	NNN			AAA	MMM	SSS		AAA	MMM	SSS
AAA	NNN	WWW			BBB	NNN	TTT		BBB	NNN	TTT
CCC	GGG	III			CCC	PPP	WWW		CCC	PPP	WWW
WWW	RRR	VVV				RRR	VVV			RRR	VVV
JJJ	AAA	UUU					WWW				WWW

Situation1
Column A, B, C, are my input data,
Situation1, Column F,G,H Are my filter Criteria List.{Filter In}

Situation2, Same situation but exclude Column J Criteria list (Filter Out)
Situation2 - Column J,K,L Are my filter Criteria List.

Option Explicit
Sub Count_as_Per_Criteria()

Dim ar1 As Variant
Dim ar2 As Variant
Dim ar3 As Variant

ar1 = Sheet1.Range("F3", Range("F" & Rows.Count).End(xlUp))
ar2 = Sheet1.Range("G3", Range("G" & Rows.Count).End(xlUp))
ar3 = Sheet1.Range("H3", Range("H" & Rows.Count).End(xlUp))

Dim i As Long, Situation1 As Long, lr As Long
lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

'Situaction 1 Include all Criteria  ' Code is working
For i = 2 To lr
    If IsNumeric(Application.Match(Sheet1.Cells(i, 1).Value, ar1, 0)) Then
         If IsNumeric(Application.Match(Sheet1.Cells(i, 2).Value, ar2, 0)) Then
            If IsNumeric(Application.Match(Sheet1.Cells(i, 3).Value, ar3, 0)) Then
                    Sheet1.Cells(i, 1).Resize(1, 3).Font.Color = vbBlue
                Situation1 = Situation1 + 1
            End If
        End If
    End If
Next i

MsgBox Situation1


'----------Situation2 Count--------------------

ar1 = Sheet1.Range("J3", Range("J" & Rows.Count).End(xlUp))
ar2 = Sheet1.Range("K3", Range("K" & Rows.Count).End(xlUp))
ar3 = Sheet1.Range("L3", Range("L" & Rows.Count).End(xlUp))

Dim Situation2 As Long

For i = 2 To lr
    If IsNumeric(Application.Match(Sheet1.Cells(i, 1).Value, ar1, 0)) = False Then 
         If IsNumeric(Application.Match(Sheet1.Cells(i, 2).Value, ar2, 0)) Then
            If IsNumeric(Application.Match(Sheet1.Cells(i, 3).Value, ar3, 0)) Then
                    Sheet1.Cells(i, 1).Resize(1, 3).Font.Color = vbRed
                Situation2 = Situation2 + 1
            End If
        End If
    End If
Next i

MsgBox Situation2


End Sub

Thanks
mg