Compare two list and add missing information from List A to List B - Revise Code

[jirpel]

Hello

Looking for some help modifying this code which compares and copies data. The current code compares a list on one “Sheet (A), Column A”; with a list of values on another “Sheet (COMPARE), Column A”. Any value in the list on Sheet (COMPARE), Column A that is not listed on Sheet (A), Column A is copied to the last row on Sheet (A) along with two adjacent columns, Sheet (COMPARE), Columns B & C.

I would like to revise this to do the same thing but instead of comparing values in Column A, it compares the values in Column B on both sheets; “Sheet (A), Column B” and “Sheet (COMPARE), Column B”.

Seems like a simple change - but just cant seem to get something to work. Appreciate the Help. Thanks.

Sub test()
With Worksheets("Compare")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
compar = .Range(.Cells(1, 1), .Cells(lastrow, 3))
End With
Worksheets("A").Select
lastdata = Cells(Rows.Count, "A").End(xlUp).Row
datar = Range(Cells(1, 1), Cells(lastdata, 1))
indi = lastdata + 1


For j = 1 To lastrow
  For i = 1 To lastdata
   fnd = False
   If datar(i, 1) = compar(j, 1) Then
    ' name found
     fnd = True
     Exit For
   End If
  Next i
  If Not (fnd) Then
      For kk = 1 To 3
       Cells(indi, kk) = compar(j, kk)
      Next kk
      indi = indi + 1
  End If
 Next j
 
End Sub

 

[Fluff]

Dou you now want to copy cols B,C & D to sheet A?

 

[jirpel]

The code will do the same. It will copy Columns A ,B ,and C from "Sheet Compare" to "Sheet A" it is not a duplicate. Thanks.

 

[Fluff]

In that case try

Sub test()
   With Worksheets("Compare")
      lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
      compar = .Range(.Cells(1, 1), .Cells(lastRow, 3))
   End With
   Worksheets("A").Select
   lastdata = Cells(Rows.Count, "B").End(xlUp).Row
   datar = Range(Cells(1, 2), Cells(lastdata, 2))
   indi = lastdata + 1
   
   
   For j = 1 To lastRow
     For i = 1 To lastdata
      Fnd = False
      If datar(i, 1) = compar(j, 2) Then
       ' name found
        Fnd = True
        Exit For
      End If
     Next i
     If Not (Fnd) Then
         For kk = 1 To 3
          Cells(indi, kk) = compar(j, kk)
         Next kk
         indi = indi + 1
     End If
    Next j
 
End Sub

 

[jirpel]

Thank you. This works perfect. However, was not sure if there is a way to modify this so that as values are added to Sheet "A" it checks to make sure no two new duplicate values are being added. Might be a matter of just adding the "last data" limit so that it updates the range it needs to check as each values are added to Sheet "A"

Book2.xlsb
	A	B	C
1	Name	Name 2	Name 3
2	1	1	A
3	2	1	B
4	3	2	C
5	4	2	D
6	5	3	E
7	6	3	F
8	7	4	G
9	8	4	H
Compare

Book2.xlsb
	A	B	C	D	E	F	G	H	I
1
2	Name	Name 2	Name 3				SHOULD SHOW
3	10	10	X				10	10	X
4	20	20	Y				20	20	Y
5	1	1	A				1	1	A
6	2	1	B				3	2	C
7	3	2	C				5	3	E
8	4	2	D				7	4	G
9	5	3	E
10	6	3	F
11	7	4	G
12	8	4	H
A

 

[Fluff]

How about

Sub jirpel()
   Dim Compar As Variant, Datar As Variant
   Dim r As Long
   
   With Worksheets("Compare")
      Compar = .Range("A1:C" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   With Worksheets("A")
      Datar = .Range("B1", .Range("B" & Rows.Count).End(xlUp)).Value2
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Compar)
         If Not .Exists(Compar(r, 2)) Then .Add Compar(r, 2), Array(Compar(r, 1), Compar(r, 2), Compar(r, 3))
      Next r
      For r = 1 To UBound(Datar)
         If .Exists(Datar(r, 1)) Then .Remove Datar(r, 1)
      Next r
      Sheets("A").Range("B" & Rows.Count).End(xlUp).Offset(1, -1).Resize(.Count, 3).Value = Application.Index(.Items, 0)
   End With
End Sub

 

[jirpel]

Thank you so much for your help. Is is a little more complicated, BUT works fantastic!!!.. Very much appreciated.

 

[Fluff]

You're welcome & thanks for the feedback.