Help Modify code to allow multiple criteria

[birpal]

Hi i was wondering if someone can edit this code so I can search by 3 criteria instead of one. Also if 1 or criteria are chosen it will give me those results aswell. This macro works perfectly just missing 2 more criteria.

The video below gives me a way to add a second filter but only if both are used i need there to be 3 cells of criteria to use and make it so that it is not necessary to have all the criteria.

Youtube Link:

Vba code:

Sub search_and_extract_singlecriteria()


Dim datasheet As Worksheet
Dim reportsheet As Worksheet
Dim athletename As String
Dim finalrow As Integer
Dim i As Integer


Set datasheet = Sheet2
Set reportsheet = Sheet6
athletename = reportsheet.Range("D1").Value


reportsheet.Range("A6:R100").ClearContents


datasheet.Select
finalrow = Cells(Rows.count, 1).End(xlUp).Row


For i = 3 To finalrow
If Cells(i, 10) = athletename Then
Range(Cells(i, 2), Cells(i, 17)).Copy
reportsheet.Select
Range("A100").End(xlUp).End(xlUp).Offset(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
datasheet.Select


End If

Next i


reportsheet.Select


Range("D1").Select


End Sub


Thank you

 

[Michael M]

Without looking at the youtube link.....I don't !!
Do you want something like this

For i = 3 To finalrow
If Cells(i, 10) = athletename [color=red]OR Cells(i, 10) = athlete2 OR Cells(i, 10) = athlete3[/color] Then
Range(Cells(i, 2), Cells(i, 17)).Copy
reportsheet.Select
Range("A100").End(xlUp).End(xlUp).Offset(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
datasheet.Select
End If
Next i

OR maybe this

    For i = 3 To finalrow
        If Cells(i, 10) = athletename Then
            Range(Cells(i, 2), Cells(i, 17)).Copy
            reportsheet.Select
            Range("A100").End(xlUp).End(xlUp).Offset(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
            datasheet.Select
        ElseIf Cells(i, 10) = athlete2 Then
            Range(Cells(i, 2), Cells(i, 17)).Copy
            reportsheet.Select
            Range("A100").End(xlUp).End(xlUp).Offset(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
            datasheet.Select
        ElseIf Cells(i, 10) = athlete3 Then
            Range(Cells(i, 2), Cells(i, 17)).Copy
            reportsheet.Select
            Range("A100").End(xlUp).End(xlUp).Offset(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
            datasheet.Select
        End If
    Next i

 

[Worf]

A suitable tool for multiple criteria filtering is Ribbon > Data > Advanced Filter.
The video uses a loop, which is unnecessary and inefficient.

 

[birpal]

Sorry for not stating earlier i need it this ways because i need to create a printable sheet in a different formated in my other sheet - in which the data is being pasted.

 

[Worf]

Does Michael’s code work for you? If not, please give a detailed explanation.