VBA code to apply multiple filters based on multiple criteria

Closed
Posts
1
Registration date
Sunday October 25, 2015
Status
Member
Last seen
October 25, 2015
-
I am looking for VBA code for below problem. there are three sheets in excel

1.Raw data (see in attached excel workbook)
2.Criteria
3.Result

Raw data sheet has 5 columns ( country, state, district, name, age ) , 80 thousand rows

Criteria sheet has 3 columns (country, state, district) , 20 rows. unique values

My expectations form the code :

I. I need to apply filters in raw data sheet with visible values of criteria sheet ,
II. if values are not found in raw data sheet values of should highlight in another color in criteria sheet.
III.what are the values found in raw data sheet should copy and paste in results sheet.

I have following code but not satisfying second expectation :if values are not found in raw data sheet , values should highlight in another color in criteria sheet.

Please review my code and please do needful.

My Code:

Sub DoIt()
Dim rs As Worksheet, Cs As Worksheet, UltSh As Worksheet
Dim Frng As Range, Crng As Range
Dim Lstrws As Long
Dim Rws As Long, rng As Range, c As Range

Set rs = Sheets("Raw Data")
Set Cs = Sheets("Criteria")
Set UltSh = Sheets("Result")

With Cs
Rws = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range(.Cells(2, "A"), .Cells(Rws, "A"))
End With

For Each c In rng.Cells
With rs
Lstrws = .Cells(.Rows.Count, "A").End(xlUp).Row
Set Frng = .Range("A1:E" & Lstrws)
Frng.AutoFilter Field:=1, Criteria1:=c
Frng.AutoFilter Field:=2, Criteria1:=c.Offset(, 1)
Frng.AutoFilter Field:=3, Criteria1:=c.Offset(, 2)
Set Crng = Frng.Offset(1)
Crng.Copy UltSh.Cells(UltSh.Rows.Count, "A").End(xlUp).Offset(1)
.AutoFilterMode = 0
End With
Next c

End Sub