Copy and Paste in different locations depending on adjacent cell value

I have the below which is meant to look for the first instance of "Test" in column B and once found copies the cells directly to the left of it and pastes it onto Sheet3 Cell AJ3 if the value of the cell 2 cells to the right of where 'Test' is found matches cell C1 but it should paste it to SHeet3 AK3 if the cell 2 cells to the right of where 'Test' is found matches cell D1. The code runs but does nothing. I'm really close I think so it must just need some minor tweaks?

Sub FirstTryTime()

Dim rng As Range
Dim ws1 As Worksheet: Set ws1 = Worksheets("Sheet2")
Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet3")

Sheets("Sheet2").Select

For Each rng In Range("B2:B" & Range("B" & Rows.Count).End(3).Row)
    If rng = "Test" Then
                    
          
                    If rng(0, 2).Value = ws1.Range("C1").Value Then
                        rng.Offset(0, -1).Copy ws2.Cells(3, "AJ").Paste
                    End If
           
                    If rng(0, 2).Value = ws1.Range("D1").Value Then
                       rng.Offset(0, -1).Copy ws2.Cells(3, "AK").Paste
                    End If
                        
             Exit For
            End If
Next rng

End Sub

This line looks unusual :

If rng(0, 2).Value = ws1.Range("C1").Value Then

as does

If rng(0, 2).Value = ws1.Range("D1").Value Then

Your Excel must be different to mine if you have a row 0
Which row are you trying to select?

Originally Posted by Kevin#

This line looks unusual :

If rng(0, 2).Value = ws1.Range("C1").Value Then

as does

If rng(0, 2).Value = ws1.Range("D1").Value Then

Your Excel must be different to mine if you have a row 0
Which row are you trying to select?

So if it finds "Test" in say cell B90 then rng(0, 2) would be cell D90. Is that right?

Originally Posted by xladept

Maybe:

Sub FirstTryTime() 'ScabbyDog

Dim rng As Range
Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2")
Dim ws3 As Worksheet: Set ws3 = Worksheets("Sheet3")

                    ws2.Select

For Each rng In Range("B2:B" & Range("B" & Rows.count).End(xlUp).Row)
    If rng = "Test" Then
          
        If rng.Offset(0, 2).Value = Range("C1").Value Then
            rng.Offset(0, -1).Copy ws3.Cells(3, "AJ")
                    End If
           
                    If rng(0, 2).Value = Range("D1").Value Then
                       rng.Offset(0, -1).Copy ws3.Cells(3, "AK")
                    End If
                        
             Exit For
            End If
Next rng

End Sub

That runs without error much like my previous code, but it does nothing. It's like it doesn't meet the criteria to paste, but it definitely does. Is it something to do with the cell references and offsets I'm thinking?

Sample.xlsm

Attached Sample file

Originally Posted by xladept

I put "Test" in B32 and ran this:

Sub FirstTryTime() 'ScabbyDog

Dim rng As Range, Wrd As String
Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2 Before")
Dim ws3 As Worksheet: Set ws3 = Worksheets("Sheet 3 Before")

                    

For Each rng In ws2.Range("B2:B" & ws2.Range("B" & Rows.count).End(xlUp).Row)
If rng.Offset(0, -1) Like "Word*" Then Wrd = rng.Offset(0, -1)
    If rng = "Test" Then
          
        If Wrd = ws2.Range("C1").Value Then
            rng.Offset(0, -1).Copy ws3.Cells(3, "AJ")
                    End If
           
                    If Wrd = ws2.Range("D1").Value Then
                       rng.Offset(0, -1).Copy ws3.Cells(3, "AK")
                    End If
                        
             Exit For
            End If
Next rng

End Sub

It runs without error, but it doesn't paste anything....it should match what is in 'Sheet 3 After' in the sample sheet.

Sample.xlsm

Silly me, attached the wrong one. Correct on here.

I see what has happened. OK, the latest attached sheet and the Sheet3 After is what I want after the macro runs. You'll see that it'll need some sort of loop I'm guessing?

Sample.xlsm

Think we're close now.

Final alteration made to the sample sheet now if you could review. Once this is done I'll give you even more rep!

Final-Sample.xlsm

Originally Posted by xladept

Hi ScabbyDog,

Try this:

Sub FirstTryTime() 'ScabbyDog

Dim rng As Range, Wrd As String, WA As Boolean, WB As Boolean
Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2 Before")
Dim ws3 As Worksheet: Set ws3 = Worksheets("Sheet 3 Before")

For Each rng In ws2.Range("B2:B" & ws2.Range("B" & Rows.count).End(xlUp).Row)
If rng.Offset(0, 2) Like "Word*" Then Wrd = rng.Offset(0, 2)
    If rng = "Test" Then
                        If WA = False Then
        If Wrd = ws2.Range("C1").Value Then
            rng.Offset(0, -1).Copy ws3.Cells(3, "AJ")
            WA = True
                End If: End If
                            If WB = False Then
                    If Wrd = ws2.Range("D1").Value Then
                       rng.Offset(0, -1).Copy ws3.Cells(3, "AK")
                       WB = True
                    End If: End If
                        
             'Exit For
            End If
Next rng

End Sub

The recent code you posted works perfectly on my sample sheet provided but not when I transfer the code to the sheet I am working on. I've attached the exact data I'll be generally using to see if you can get it to work with it! No idea why it wouldn't be working as the cell references are still correct. I'm guessing it's something to do with finding the last used row in column B?

Final-Sample.xlsm

Thanks so much! Really appreciate your help with this. Solved!