How to copy adjacent cell

[ceclay]

Hi,
I have this code below which find unique words on 2 columns.

Sub Match1()
    
    Dim CC As Worksheet
    Dim lrA As Long
    Dim lrE As Long
    Dim rngA As Range
    Dim rngE As Range
    Dim cell As Range
    
    Application.ScreenUpdating = False
    
    Set CC = Sheets("Sheet2")
    
'   Find last row with data in column A
    lrA = CC.Cells(Rows.Count, "A").End(xlUp).Row
'   Find last row with data in column B
    lrE = CC.Cells(Rows.Count, "E").End(xlUp).Row
    
'   Set data ranges
    Set rngA = CC.Range("A2:A" & lrA)
    Set rngE = CC.Range("E2:E" & lrE)
    
'   Loop through all rows in column E
    For Each cell In rngA
'       Search for value in column A
        If Application.WorksheetFunction.CountIf(rngE, cell.Value) = 0 Then
'           Copy value to column F
            Cells(Rows.Count, "F").End(xlUp).Offset(1, 0) = cell.Value
        End If
    Next cell

    
    Application.ScreenUpdating = True
    
    
End Sub

My problem now is how I am going to copy its to make it like below: (Note that from code above I was only able to copy the unique words on Column A and not its adjacent cell)

Apple	1234			Apple	Banana	1345
Banana	1345			Grapes	Guyabano	4566
Guyabano	4566			Santol	Pear	543
Grapes	211			Cherry	Melon	211
Pear	543			Pomegrate	Oranges	32
Melon	211			Watermelon
Apple	1452
Santol	12
Watermelon	23
Oranges	32
Cherry	55

Hoping for your response.

 

[Osvaldo Palmeiro]

Hi. Try after adding the red line as below.
Cells(Rows.Count, "F").End(xlUp).Offset(1, 0) = cell.Value
Cells(Rows.Count, "G").End(xlUp).Offset(1, 0) = cell.Offset(, 1).Value


just a note abaout this comment ~~~> ' Loop through all rows in column E ~~~> the looping is running on column A instead

As an alternative, if Sheets2 is the active sheet as you run the code, then the simplified code below will do the job too.

Sub Match1V2()
 Dim cell As Range
  Application.ScreenUpdating = False
  For Each cell In Range("A2:A" & Cells(Rows.Count, 1).End(3).Row)
   If Application.CountIf([E:E], cell.Value) = 0 Then
    Cells(Rows.Count, "F").End(3)(2) = cell.Value
    Cells(Rows.Count, "G").End(3)(2) = cell.Offset(, 1).Value
   End If
  Next cell
End Sub

 

[ceclay]

Thank you @Osvaldo Palmeiro !