VBA to copy & Paste Adjacent cell when value found

It is not clear whether you want to copy columns C and D of sheet 2 in to O and P of sheet 1 as column P of sheet has value, or you want copy them on the same sheet.
Just clarify which columns of which sheet should be pasted in to which sheet and column.

I will move the P column of sheet2 to right which would make P column "blank".

I need VBA to copy C & D of Sheet2 to O & P of Sheet1.

Thanks you so much for your help!

Regards

My given code searches N2 of Sheet1 thru the value of column C in Sheet2 and when it find "Yes" under column G for found Value in C it copies the entire row of sheet1 and paste it in sheet3(Data GV).

but instead of copying the sheet1, I want adjacent cell value of C column of sheet2 ( Cell D and F) to be copied and pasted back in Sheet1 Adjacent value of N2.
E.g. if N2 of Sheet1 value is found under C6 of Sheet2 ( Provided it meets the condition of "Yes" in same row of G column) it copies the D6 and E6 and copy back to O2 & P2 of Sheet1.

Hope this help.

Thanks a bunch!!

Regards,

116 views, no reply yet. Strange!!! I thought this would be easy code..!
AM still trying to fix the code not luck yet.

Thanks

I have not ignored you, I was off-site.

Sub Data_Updation1()
 Dim ms As Worksheet
Application.ScreenUpdating = False
Set ms = Sheets("Sheet1")

  With Sheets("Sheet2")
    For Each cell In .Range("C2:C" & .Range("C" & .Rows.Count).End(xlUp).Row)
        If cell.Value = ms.Range("N2") And Cells(cell.Row, "G") = "Yes" Then
          .Cells(cell.Row, "C").Resize(, 2).Copy ms.Range("O" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next cell
  End With
Application.ScreenUpdating = True

End Sub

Thanks AB.

Screenflickers, but nothing gets copied or pasted.

Regards,
Shiva

Shiva,
You only have two rows with UA01(Rows 3 and 4) and column G has to be also yes. If one of the condition is not met, the code will return false.

Hi,

I am not sure what is going wrong here but I am not able to execute your code. For me, I just get screenflicker but not else.
I have attached the spreadsheet with your code added in it.

FYI. I use MS Excel 2010. I had the similar issue once when I used 2003 code in Excel 2010. I see you have been using 2010 so not sure what is wrong.

I have now added another code, so you have two working codes.

Note: Sheet2 has 30,000 rows data. When I tried to execute your code I received error message "Run Time Error '7' Out of Memory" on below line

ReDim y(1 To UBound(x, 1) * UBound(x, 1), 1 To 2)

Your this code works like a charm.!! Thank you so much for your assistance.
One tweak request. I wanted the same code in another my project but your code is tricky for me to tweak to my preference. I never understood the concept of X & Y even on my school

Here what I have in another spreadsheet.
1) Instead of column C of lookup search in Sheet2, I would like to replace lookup search to column B (Sheet2).
2) Instead of Column G (Yes) in sheet2, this time I want Column C "No"
3) Keep the C & D as it is, as I will be copying cell C & D from sheet2
4) Data to be pasted in P & Q of Sheet1 ( Earlier it was O & P )

your code below for easy reference.

Sub trans()
Dim x, y(), i&, j&, k&, ms As Worksheet
Set ms = Sheets("Sheet1")
x = Sheets("Sheet2").Range("A1:H" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row)
   
    ReDim y(1 To UBound(x, 1) * UBound(x, 1), 1 To 2)
    For i = 2 To UBound(x, 1)
        If x(i, 3) = ms.Range("N2") And x(i, 7) = "Yes" Then
             k = k + 1
             y(k, 1) = x(i, 3)
             y(k, 2) = x(i, 4)
            End If
    Next i
ms.Range("O2").Resize(k, 2).Value = y()

End Sub

Thank you so much for your help. You are the best!

Regards
Shiva

Use this line, if this does not work, I need to see your large sample.

ReDim y(1 To UBound(x, 1), 1 To 2)

Great. It do not give me Out of memory error now.

Now I get "Run time error '1004': Application - defined or object - defined error on below code.

ms.Range("O2").Resize(k, 2).Value = y()

However, I still need your help in changing the cell values.
Here what I have in another spreadsheet.
1) Instead of column C of lookup search in Sheet2, I would like to replace lookup search to column B (Sheet2).
2) Instead of Column G (Yes) in sheet2, this time I want Column C "No"
3) Keep the C & D as it is, as I will be copying cell C & D from sheet2
4) Data to be pasted in P & Q of Sheet1 ( Earlier it was O & P )

Thanks

Please attach your new sample.

Sorry for the delay. Had issue in uploading the file.

Try the attached.

hey AB,

It works, but in this spreadsheet I need pick value to be "No". Your code works as long as it stays "Yes" but when I change it to "No" in your code, I get run time error on below line

ms.Range("P6").Resize(k, 2).Value = y()

Advice please.

Thanks

It means the array returns 0 as there is no row which has no.
Change the last line in to

If k > 0 Then ms.Range("P6").Resize(k, 2).Value = y()

changed, I do not get error but nothing happens.

That was exactly what I said in my last post.
The conditions of No and match value of L column return 0. For the code to copy both conditions ought to be right, not just one.
If you want one condition to be true, change the AND to OR.

cool. Per your instruction I changed the code

Sub trans()
Dim x, y(), i&, j&, k&, ms As Worksheet
Set ms = Sheets("Sheet1")
x = Sheets("Sheet2").Range("A1:E" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row)
   
    ReDim y(1 To UBound(x, 1), 1 To 2)
    For i = 2 To UBound(x, 1)
        If x(i, 2) = ms.Range("L6") Or x(i, 3) = "No" Then
             k = k + 1
             y(k, 1) = x(i, 3)
             y(k, 2) = x(i, 4)
            End If
    Next i
If k > 0 Then ms.Range("P6").Resize(k, 2).Value = y()

End Sub

works like a charm.. Thank you so much for your help.

Regards
Shiva