Copy paste if contains certain value between three column - vba

Question

I'm wondering about how to use "worksheet-change" the best way possible. Right now I use it to copy from one column to another column, in two different sheets. Whenever the column in Sheet1 is updated, column in Sheet2 will as well be updated. Using two columns is no problem and the code works fine!
My issue is whenever I want to use three columns. I want it to loop through column A and whenever it finds the word "Orange" in it, it should copy column B to coulmn A in sheet2.See my sheet for more detailed information.
If it finds Orange, it should only copy and updated the values "1,3,6" in Column B to column A in sheet2.
A code I tried with but didn't work, it copied everything to column B. If it is possible to use VLOOKUP, how do I do that? Because I tried that but it didnt updated whenever a cell was changed.
Dim x As Range
With Sheets("Sheet1")
Set x = .Columns(1).Find("Orange", LookIn:=xlValues, lookat:=xlWhole)
If Not x Is Nothing Then
.Columns(2).Copy Sheets("Sheet2").[B1]
End If
Set x = Nothing
End With
Example:
Workbook 1:
Column A
Orange
apple
Orange
Pear
Berry
Orange
Column B:
1
2
3
4
5
6
Should populate into a new sheet where only "1,3,6" is pasted in column B sheet2

Answer 1

I think you're better served by using the Workbook_SheetDeactivate event. By using this event (only when the user selects a sheet away from your source sheet), you're only performing the copy once. As an alternate and/or addition, you could perform the same copy from the Workbook_BeforeSave event (just in case the user saves and exits the workbook without changing sheets).
Option Explicit
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Dim activeRange As Range
Dim lastRow As Long
Dim c As Range
If Sh.Name = "Sheet1" Then
lastRow = Sh.Range("A" & Rows.Count).End(xlUp).Row
Set activeRange = Sh.Range("A1:A" & lastRow)
For Each c In activeRange
If c.Value = "Orange" Then
Sheets("Sheet2").Range(c.Offset(0, 1).Address) = c.Offset(0, 1).Value
End If
Next c
Debug.Print "done"
End If
End Sub

Answer 2

Try this:
Sub Fruity()
Application.ScreenUpdating = False
Dim LastRow As Integer
'Search code
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim i As Long
For i = 1 To LastRow
If ThisWorkbook.Sheets("Sheet1").Range("A" & i) = "Orange" Then
Set NextCell = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp)
If NextCell = "" Then
NextCell = ThisWorkbook.Sheets("Sheet1").Range("B" & i)
Else
NextCell.Offset(1) = ThisWorkbook.Sheets("Sheet1").Range("B" & i)
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
I am not sure what your target is for Worksheet_Change, so you'll have to clarify your question or add that on your own.
*edit: now puts the column B values from Sheet1 into column B in Sheet2 beginning at B1 instead of putting them in the row that corresponds with the found "Orange."