Matching Two Strings then copy paste Data

Question

I have been trying to make a function where it matches 2 separate strings with two column then copy corresponding columns data and paste into separate sheet.

I am stuck on that thing how to make 2 matches like For Each cell In myDataRng & myDataRng2.

your help will be appreciated

Sub Tester()
    
    Dim myDataRng, myDataRng2 As Range
    Dim cell As Range, wsSrc As Worksheet, wsDest As Worksheet
    Dim destRow As Range
    Dim FindValue As String
    Dim FindValue2 As String
    
    Set wsSrc = Worksheets("Sheet1")  'source sheet
    Set wsDest = Worksheets("Sheet2") 'destination sheet
    
    FindValue = wsDest.Range("A2").Value
    FindValue2 = wsDest.Range("B2").Value
    
    Set myDataRng = wsSrc.Range("F2:F" & wsSrc.Cells(Rows.Count, "F").End(xlUp).Row)
    Set myDataRng2 = wsSrc.Range("A2:A" & wsSrc.Cells(Rows.Count, "A").End(xlUp).Row)
    
    Set destRow = wsDest.Rows(2)  'first destination row
    
    For Each cell In myDataRng
        If InStr(1, cell.Value, FindValue) > 0 Then
        
            With cell.EntireRow 'the whole matching row
                destRow.Cells(5).Value = .Cells(2).Value
                destRow.Cells(6).Value = .Cells(3).Value
                destRow.Cells(7).Value = .Cells(4).Value
                destRow.Cells(8).Value = .Cells(5).Value
            End With
            
            Set destRow = destRow.Offset(1, 0) 'next destination row
            
        End If
    Next cell

End Sub

Other Condition

Sub find()

Dim foundRng As Range
Dim mValue As String

Set shData = Worksheets("Sheet1")
Set shSummary = Worksheets("Sheet2")

mValue = shSummary.Range("C2")

    Set foundRng = shData.Range("G1:Z1").find(mValue)
    'If matches then copy macthed Column and paste into Sheet2 Col"I" (as above code psting the data into Sheet2)
    
End Sub

Answer 1

I like using rows for loops like this because it makes it very easy to read the code and understand what is happening. By breaking the search range into a series of rows, everything becomes simple to write and read.

Sub Tester()
    
    Dim myDataRng, myDataRng2 As Range
    Dim rRow As Range, wsSrc As Worksheet, wsDest As Worksheet
    Dim destRow As Range
    Dim FindValue As String
    Dim FindValue2 As String
    
    Set wsSrc = Worksheets("Sheet1")  'source sheet
    Set wsDest = Worksheets("Sheet2") 'destination sheet
    
    FindValue = wsDest.Range("A2").Value
    FindValue2 = wsDest.Range("B2").Value
    
    Set myDataRng = wsSrc.Range("F2:F" & wsSrc.Cells(Rows.Count, "F").End(xlUp).Row)
    'Set myDataRng2 = wsSrc.Range("A2:A" & wsSrc.Cells(Rows.Count, "A").End(xlUp).Row)
    
    Set destRow = wsDest.Rows(2)  'first destination row
    
    For Each rRow In myDataRng.Rows.EntireRow
        If InStr(1, rRow.Columns("F").Value, FindValue) > 0 _
        And InStr(1, rRow.Columns("A").Value, FindValue2) > 0 Then
        
            With rRow.EntireRow 'the whole matching row
                destRow.Cells(5).Value = .Cells(2).Value
                destRow.Cells(6).Value = .Cells(3).Value
                destRow.Cells(7).Value = .Cells(4).Value
                destRow.Cells(8).Value = .Cells(5).Value
            End With
            
            Set destRow = destRow.Offset(1, 0) 'next destination row
            
        End If
    Next rRow

End Sub
    Set wsSrc = Worksheets("Sheet1")  'source sheet
    Set wsDest = Worksheets("Sheet2") 'destination sheet
    
    FindValue = wsDest.Range("A2").Value
    FindValue2 = wsDest.Range("B2").Value
    
    Set myDataRng = wsSrc.Range("F2:F" & wsSrc.Cells(Rows.Count, "F").End(xlUp).Row)
    'Set myDataRng2 = wsSrc.Range("A2:A" & wsSrc.Cells(Rows.Count, "A").End(xlUp).Row)
    
    Set destRow = wsDest.Rows(2)  'first destination row
    
    For Each rRow In myDataRng.Rows
        If InStr(1, rRow.Columns("F").Value, FindValue) > 0 _
        And InStr(1, rRow.Columns("A").Value, FindValue2) > 0 Then
        
            With rRow.EntireRow 'the whole matching row
                destRow.Cells(5).Value = .Cells(2).Value
                destRow.Cells(6).Value = .Cells(3).Value
                destRow.Cells(7).Value = .Cells(4).Value
                destRow.Cells(8).Value = .Cells(5).Value
            End With
            
            Set destRow = destRow.Offset(1, 0) 'next destination row
            
        End If
    Next rRow

End Sub

Answer 2

Several options:

If Instr(1, cell.Offset(,-5).Value, FindValue2) > 0 Then

If InStr(1, wsSrc.Range("A" & cell.Row), FindValue2) > 0 Then

and others.