Copy paste if contains certain value between three column

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

1. Orange
2. apple
3. Orange
4. Pear
5. Berry
6. Orange

Column B:

1. 1
2. 2
3. 3
4. 4
5. 5
6. 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."