Compare two lists and paste content if match is found

jeffsdan

New Member
Joined
Feb 13, 2014
Messages
13
I need to search the content from one list (List A, Column A) for the mention of items from another list (List B, Column A), and if any matches are found, I need to publish in Column B of List A the data from Column B of the associated matching item of List B. Can anyone help?
Tables below to help clarify what I'm asking.



List A (The list being searched)
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]List A[/TD]
[TD]Column B (blank)[/TD]
[/TR]
[TR]
[TD]The bucket e(5) was full[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]The broom stood[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]The call came d(4)[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


List B (The reference list - e.g., "does list A contain any of these items")

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]List B[/TD]
[TD]Column B[/TD]
[/TR]
[TR]
[TD]d(4)[/TD]
[TD]d(4) Yeah[/TD]
[/TR]
[TR]
[TD]e(5)[/TD]
[TD]e(5) No![/TD]
[/TR]
[TR]
[TD]f(6)[/TD]
[TD]f(6) Ok[/TD]
[/TR]
</tbody>[/TABLE]


What I need the final product to look like:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]List A[/TD]
[TD]Added text from List B, Column B[/TD]
[/TR]
[TR]
[TD]The bucket e(5) was full[/TD]
[TD]e(5) No![/TD]
[/TR]
[TR]
[TD]The broom stood[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]The call came d(4)[/TD]
[TD]d(4) Yeah[/TD]
[/TR]
</tbody>[/TABLE]
 
Calltech,

I have had problems in the past when attempting to download an Excel file with macros, with the xlsm file extension.

Please remove all macros, and, then rename the workbooks using the xlsx file extension, and, then repost on dropbox.


And, then you can post the macros in your next reply:

When posting VBA code, please use Code Tags - like this:

[code=rich]

Paste your code here.

[/code]
 
Upvote 0

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Dear hiker95!

Here is the original workbook.

Run orignal.xlsx with "Combine_CompareListsV5_and_remDup" macro.

Code:
Sub Combine_CompareListsV5_and_remDup()CompareListsV5
remDup
End Sub
Sub CompareListsV5()
' hiker95, 12/06/2015, ME759006 <- Thank You!
Dim b As Variant, i As Long
Dim a As Variant, o As Variant
Dim r As Long, lr As Long, c As Long, lc As Long, t As String
Application.ScreenUpdating = False
With Sheets("List B")
  b = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets("List A")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  ReDim o(1 To lr, 1 To 1)
  For r = 1 To lr
    t = ""
    For c = 1 To lc Step 1
      For i = LBound(b, 1) To UBound(b, 1)
        If Not a(r, c) = vbEmpty Then
          If InStr(a(r, c), b(i, 1)) Then
            If t = "" Then
              t = b(i, 2)
            Else
              t = t & " " & b(i, 2)
            End If
          End If
        End If
      Next i
    Next c
    o(r, 1) = t
  Next r
  .Columns(1).Insert
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub


Sub remDup()
'Richard Schollar, 08/06/2009, ME407809 <- Thank You!
Dim dic As Object, cell As Range, temp As Variant
Dim i As Long
Set dic = CreateObject("scripting.dictionary")
With dic
    For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        .RemoveAll
        If Len(cell.Value) > 0 Then
            temp = Split(cell.Value, " ")
            For i = 0 To UBound(temp)
                If Not .Exists(temp(i)) Then .Add temp(i), temp(i)
            Next i
            cell.Value = Join(.Keys, " ")
        End If
    Next cell
    Columns("A:A").EntireColumn.AutoFit
End With
        
End Sub

And here is the changes of original.xlsx how to need to look.

Sorry again for the incorrect sharings. Next time I will have been correctly.

Thank You!
 
Upvote 0
Calltech,

When I attempted do download/open changes.xlsx I received the following message:

Excel found unreadable content in 'changes.xlsx'. Do you want to recover the content of this workbook? If you trust the source of this workbook, click Yes.
 
Upvote 0
Calltech,

When I attempted do download/open changes.xlsx I received the following message:

Excel found unreadable content in 'changes.xlsx'. Do you want to recover the content of this workbook? If you trust the source of this workbook, click Yes.

I don't know, why did you get this message. I think click to Yes.
 
Upvote 0
Calltech,

I will not do that.

Please try again with your workbook on dropbox.

Can you opened the original.xlsx successfully? Is this show same message? ( I added notes to the changes.xlsx for help, what I would like to change. But if you would like, I creat and upload a new workbook, which maybe not show this message again. Now I'm not computer nearby, only tomorrow. So I can do that only tomorrow. Sorry.)
 
Upvote 0
I created with Forum Tools.

Original workbook:

Before macro:

Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A
[/TH]
[TH]
B
[/TH]
[TH]
C
[/TH]
[TH]
D
[/TH]
[TH]
E
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1
[/TD]
[TD]The bucket e(5) was d(4) full[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2
[/TD]
[TD]The broom stood[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]The broom f(6)[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3
[/TD]
[TD]The call came d(4)[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: LIST A[/TD]
[/TR]
</tbody>[/TABLE]

Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A
[/TH]
[TH]
B
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1
[/TD]
[TD]d(4)[/TD]
[TD]d(4) Yeah![/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2
[/TD]
[TD]e(5)[/TD]
[TD]e(5) No![/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3
[/TD]
[TD]f(6)[/TD]
[TD]f(6) Ok[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: LIST B[/TD]
[/TR]
</tbody>[/TABLE]

After macro:

Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A
[/TH]
[TH]
B
[/TH]
[TH]
C
[/TH]
[TH]
D
[/TH]
[TH]
E
[/TH]
[TH]
F
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1
[/TD]
[TD]d(4) Yeah! e(5) No![/TD]
[TD]The bucket e(5) was d(4) full[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2
[/TD]
[TD]f(6) Ok[/TD]
[TD]The broom stood[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]The broom f(6)[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3
[/TD]
[TD]d(4) Yeah![/TD]
[TD]The call came d(4)[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: LIST A[/TD]
[/TR]
</tbody>[/TABLE]

Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A
[/TH]
[TH]
B
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1
[/TD]
[TD]d(4)[/TD]
[TD]d(4) Yeah![/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2
[/TD]
[TD]e(5)[/TD]
[TD]e(5) No![/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3
[/TD]
[TD]f(6)[/TD]
[TD]f(6) Ok[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: LIST B[/TD]
[/TR]
</tbody>[/TABLE]

Original's Macro:

Code:
Sub Combine_CompareListsV4_and_remDup()
CompareListsV4
remDup
End Sub
Sub CompareListsV4()
' hiker95, 12/06/2015, ME759006 <- Thank You!
Dim b As Variant, i As Long
Dim a As Variant, o As Variant
Dim r As Long, lr As Long, c As Long, lc As Long, t As String
Application.ScreenUpdating = False
With Sheets("List B")
  b = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets("List A")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  ReDim o(1 To lr, 1 To 1)
  For r = 1 To lr
    t = ""
    For c = 1 To lc Step 1
      For i = LBound(b, 1) To UBound(b, 1)
        If Not a(r, c) = vbEmpty Then
          If InStr(a(r, c), b(i, 1)) Then
            If t = "" Then
              t = b(i, 2)
            Else
              t = t & " " & b(i, 2)
            End If
          End If
        End If
      Next i
    Next c
    o(r, 1) = t
  Next r
  .Columns(1).Insert
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Sub remDup()
'Richard Schollar, 08/06/2009, ME407809 <- Thank You!
Dim dic As Object, cell As Range, temp As Variant
Dim i As Long
Set dic = CreateObject("scripting.dictionary")
With dic
    For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        .RemoveAll
        If Len(cell.Value) > 0 Then
            temp = Split(cell.Value, " ")
            For i = 0 To UBound(temp)
                If Not .Exists(temp(i)) Then .Add temp(i), temp(i)
            Next i
            cell.Value = Join(.Keys, " ")
        End If
    Next cell
    Columns("A:A").EntireColumn.AutoFit
End With
        
End Sub

Changes workbook:

Before macro:

Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A
[/TH]
[TH]
B
[/TH]
[TH]
C
[/TH]
[TH]
D
[/TH]
[TH]
E
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1
[/TD]
[TD]The bucket e(5) was d(4) full[/TD]
[TD]other content[/TD]
[TD]else10[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2
[/TD]
[TD]The broom stood[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]The broom f(6)[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3
[/TD]
[TD]The call came d(4)[/TD]
[TD]other content[/TD]
[TD]else2[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: LIST A[/TD]
[/TR]
</tbody>[/TABLE]

Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A
[/TH]
[TH]
B
[/TH]
[TH]
C
[/TH]
[TH]
D
[/TH]
[TH]
E
[/TH]
[TH]
F
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1
[/TD]
[TD]d(4)[/TD]
[TD]else1[/TD]
[TD]else2[/TD]
[TD]else3[/TD]
[TD]else4[/TD]
[TD]d(4) Yeah![/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2
[/TD]
[TD]else5[/TD]
[TD]else6[/TD]
[TD]else7[/TD]
[TD]e(5)[/TD]
[TD]else8[/TD]
[TD]e(5) No![/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3
[/TD]
[TD]f(6)[/TD]
[TD]else9[/TD]
[TD]else10[/TD]
[TD]else11[/TD]
[TD]else12[/TD]
[TD]f(6) Ok[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: LIST B[/TD]
[/TR]
</tbody>[/TABLE]

After macro:

Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A
[/TH]
[TH]
B
[/TH]
[TH]
C
[/TH]
[TH]
D
[/TH]
[TH]
E
[/TH]
[TH]
F
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1
[/TD]
[TD]d(4) Yeah! e(5) No! f(6) Ok[/TD]
[TD]The bucket e(5) was d(4) full[/TD]
[TD]other content[/TD]
[TD]else10[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2
[/TD]
[TD]f(6) Ok[/TD]
[TD]The broom stood[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[TD]The broom f(6)[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3
[/TD]
[TD]d(4) Yeah! d(4) Yeah![/TD]
[TD]The call came d(4)[/TD]
[TD]other content[/TD]
[TD]else2[/TD]
[TD]other content[/TD]
[TD]other content[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: LIST A[/TD]
[/TR]
</tbody>[/TABLE]

Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A
[/TH]
[TH]
B
[/TH]
[TH]
C
[/TH]
[TH]
D
[/TH]
[TH]
E
[/TH]
[TH]
F
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1
[/TD]
[TD]d(4)[/TD]
[TD]else1[/TD]
[TD]else2[/TD]
[TD]else3[/TD]
[TD]else4[/TD]
[TD]d(4) Yeah![/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2
[/TD]
[TD]else5[/TD]
[TD]else6[/TD]
[TD]else7[/TD]
[TD]e(5)[/TD]
[TD]else8[/TD]
[TD]e(5) No![/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3
[/TD]
[TD]f(6)[/TD]
[TD]else9[/TD]
[TD]else10[/TD]
[TD]else11[/TD]
[TD]else12[/TD]
[TD]f(6) Ok[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: LIST B[/TD]
[/TR]
</tbody>[/TABLE]

The only changes in new macro, that the LIST B - Column A supplemented with +4 columns.

Thank You for your help.
 
Last edited:
Upvote 0
Of course in the end the duplication disappears in LIST A - Column A with the part of "remDup" macro.
 
Upvote 0

Forum statistics

Threads
1,223,264
Messages
6,171,081
Members
452,377
Latest member
bradfordsam

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
Back
Top