Copy rows with multiple sub criteria

Question

I'm working on a macro that will search a List sheet for different counties and then paste the entire row onto the current sheet. I have a worksheet for each person (named Mark, John, etc.) and each person is assigned several counties. Mark has three counties, listed in cells J1:L1, which I've named as a range (MyCounties). My macro looks through Sheet "List" column "I" for each of those counties and copy the entire row onto Sheet "Mark" starting at "A4". The macro that I have works very well for that.

For larger areas like Los Angeles County though, it gets split up between 6 people, who each take different cities within that county, and within the city of LA itself, take different zip codes. Is it possible to search for matching county and then city (for all cities not LA), as well as for Los Angeles (city) and then zip code? County is column "I", City is column "G", and Zip is column "H". So "Andrew" would have within LA county cities of Alhambra, Arcadia, etc. and also LA (city) zip codes of 90004, 90006, etc. I know that the macro posted below won't work for this, but is there a way to edit it to make it do what I want? I have a helper sheet ("Los Angeles") that shows persons name (Peter) in A1:D1 (Merged Cells), B3 and down are Counties to filter by, C3 and down are cities to filter by, and D3 and down are zip codes to filter by. Then we skip a column, and F1:I1 is next person.

I have a test document that I'll attach as soon as I figure out how to do that. test doc

Sub MoreReports()
    Dim w As Long, cVar As Variant, zVar As Variant, rw As Long, sDoc As Worksheet, tDoc As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set sDoc = Sheets("List")
    Set tDoc = Sheets("Peter")
    Set cVar = Sheets("Los Angeles").Range("C3:C52")
    Set zVar = Sheets("Los Angeles").Range("d3:d52")


         With sDoc
            If .AutoFilterMode Then .AutoFilterMode = False
            With .Range(.Cells(4, "G"), .Cells(.Rows.Count, "I").End(xlUp))
                .AutoFilter field:=3, Criteria1:="Los Angeles", Operator:=xlAnd
                .AutoFilter field:=1, Criteria1:=cVar, Operator:=xlFilterValues
                .AutoFilter field:=1, Criteria1:="Los Angeles", Operator:=xlAnd
                .AutoFilter field:=2, Criteria1:=zVar, Operator:=xlFilterValues
                .AutoFilter field:=3, Criteria1:="Ventura", Operator:=xlFilterValues                    
                With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        .Cells.EntireRow.Copy Destination:=tDoc.Cells(rw, "A")
                    End If
                End With
            End With
            If .AutoFilterMode Then .AutoFilterMode = False
        End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Have you looked at an If statement with multiple conditions? Something like IF AND(crit1, crit2, crit3) THEN would allow you to put each of the three criteria you specify in your question (Is it possible to search for matching county and then city (for all cities not LA), as well as for Los Angeles (city) and then zip code? County is column "I", City is column "G", and Zip is column "H". So "Andrew" would have within LA county cities of Alhambra, Arcadia, etc. and also LA (city) zip codes of 90004, 90006, etc.). Your criteria could use MATCH() or FIND(), even. — Cyril
I'm fairly new to coding (the code posted above is a modification of code Jeeped posted for me in another question. He recommended that since this question is quite a bit different than that one, I should start a new question. Which is to say: I'd love to use an If statement for these criteria, but I don't know the syntax to use, or how/where to insert it into my existing code. — user4907546
So, I've looked at the test doc and I'm a little a little taken asunder. If I can follow this... you want your sheet "Los Angeles" as a reference sheet to create an if-statement and move rows from the sheet "List" to the individual named sheets? — Cyril

Cyril Cyril · Accepted Answer · 2017-03-09T16:57:37

So, I'm going to try to give one example for this (Thomas). Note that I am looking at the city/zip only, as the county should be inclusive of these two unique values; some cities can share the same zip.

The overall process I intend to follow is:

.1) Remember the range on the reference sheet (I do this so I can set my matches up correctly)

Sheets("Los Angeles").Range("W4:W15") 'City
Sheets("Los Angeles").Range("X4:X15") 'Zip

.2) Remember the range on the List sheet

Sheets("List").Range("G6:G338") 'City
Sheets("List").Range("H6:H338") 'Zip

.3) Set-up a loop for sorting through Thomas' references

Dim i As Integer

For i = 15 to 4

.4) Within the loop, create another loop to search the values on the List

Dim j As Integer

For j = 6 to 338

.5) Use an If-statement to check the condition

If Match(Sheets("Los Angeles").Range("W"&j),Sheets("List").Range("G"&i))=Match(Sheets("Los Angeles").Range("X"&j),Sheets("List").Range("H"&i)) Then

.6) If conditions are met, then we will cut and paste the row to the appropriate sheet

Sheets("List").Row(j).Copy Sheets("Thomas").Row(j)

.7) Close the If-statement

End If

.8) Go to the next j in the loop

Next j

.9) Go to the next i in the loop

Next i

.10) Filter Thomas' sheet by Zip code (should remove all empty rows)

Sheets("Thomas").Range("A1:I338").Sort key1:=Range("H1:H338"), order1:=xlAscending, Header:=xlYes

With this one example, you should be able to set-up each other person's sheets!

Altogether, it looks like (there may be better ways, but this was the easiest of the Match() things I could think of, which in my head seemed easier than the Find() alternative):

Dim i As Integer
Dim j As Integer

For i = 15 to 4
    For j = 6 to 338

        If Match(Sheets("Los Angeles").Range("W"&j),Sheets("List").Range("G"&i))=Match(Sheets("Los Angeles").Range("X"&j),Sheets("List").Range("H"&i)) Then
            Sheets("List").Row(j).Copy Sheets("Thomas").Row(j)
        End If
    Next j
Next i

Copy rows with multiple sub criteria

1 Answers