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

jirpel

New Member
Joined
Jan 28, 2019
Messages
9
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.


VBA Code:
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
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,252
Office Version
  1. 365
Platform
  1. Windows
Dou you now want to copy cols B,C & D to sheet A?
 

jirpel

New Member
Joined
Jan 28, 2019
Messages
9
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,252
Office Version
  1. 365
Platform
  1. Windows
In that case try
VBA Code:
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

New Member
Joined
Jan 28, 2019
Messages
9

ADVERTISEMENT

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
ABC
1NameName 2Name 3
211A
321B
432C
542D
653E
763F
874G
984H
Compare


Book2.xlsb
ABCDEFGHI
1
2NameName 2Name 3SHOULD SHOW
31010X1010X
42020Y2020Y
511A11A
621B32C
732C53E
842D74G
953E
1063F
1174G
1284H
A
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,252
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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
 
Solution

jirpel

New Member
Joined
Jan 28, 2019
Messages
9
Thank you so much for your help. Is is a little more complicated, BUT works fantastic!!!.. (y) Very much appreciated.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,252
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Forum statistics

Threads
1,141,068
Messages
5,704,094
Members
421,327
Latest member
Msh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top