Compare two lists and paste content if match is found

[jeffsdan]

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)

List A	Column B (blank)
The bucket e(5) was full
The broom stood
The call came d(4)

<tbody>
</tbody>

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

List B	Column B
d(4)	d(4) Yeah
e(5)	e(5) No!
f(6)	f(6) Ok

<tbody>
</tbody>

What I need the final product to look like:

List A	Added text from List B, Column B
The bucket e(5) was full	e(5) No!
The broom stood
The call came d(4)	d(4) Yeah

<tbody>
</tbody>

 

[hiker95]

jeffsdan,

The following is based on the raw data in both worksheets per your above screenshots.

Sample worksheets:

Excel 2007
	A	B
1	d(4)	d(4) Yeah
2	e(5)	e(5) No!
3	f(6)	f(6) Ok
4
List B

Excel 2007
	A	B
1	The bucket e(5) was full
2	The broom stood
3	The call came d(4)
4
List A

After the macro:

Excel 2007
	A	B
1	The bucket e(5) was full	e(5) No!
2	The broom stood
3	The call came d(4)	d(4) Yeah
4
List A

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub CompareLists()
' hiker95, 02/20/2014, ME759006
Dim c As Range, frng As Range
With Sheets("List B")
  For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    Set frng = Sheets("List A").Columns(1).Find("*" & c & "*", LookAt:=xlWhole)
    If Not frng Is Nothing Then
      Sheets("List A").Cells(frng.Row, 2).Value = c.Offset(, 1).Value
    End If
  Next c
End With
With Sheets("List A")
  .Columns(2).AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CompareLists macro.

 

[hiker95]

jeffsdan,

With the same screenshots as my reply #2.

The following macro using two arrays in memory may be faster.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub CompareListsV2()
' hiker95, 02/20/2014, ME759006
Dim b As Variant, a As Variant
Dim i As Long, ii As Long
With Sheets("List B")
  b = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
With Sheets("List A")
  a = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
For i = 1 To UBound(b, 1)
  For ii = 1 To UBound(a, 1)
    If InStr(a(ii, 1), Trim(b(i, 1))) Then
      a(ii, 2) = b(i, 2)
    End If
  Next ii
Next i
With Sheets("List A")
  .Cells(1, 1).Resize(UBound(a, 1), UBound(a, 2)) = a
  .Columns(2).AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CompareListsV2 macro.

 

[jeffsdan]

Works great, except that I just noticed that some cells have two notations in them (like below, List A, Row 1). Any way for both notations to be defined in the cells separated by a space?

	A	B
1	The bucket e(5) was d(4) full	e(5) No! d(4) Yeah!
2	The broom stood
3	The call came d(4)	d(4) Yeah
4

<tbody>
</tbody>

 

[hiker95]

jeffsdan,

Thanks for the feedback.

Be back in a little while.

 

[hiker95]

jeffsdan,

Because of the way the raw data is listed in worksheet List B for searching purposes, the results will be slightly different:

In stead of this:
e(5) No! d(4) Yeah!

We get this:
d(4) Yeah! e(5) No!


Sample raw data:

Excel 2007
	A	B
1	d(4)	d(4) Yeah!
2	e(5)	e(5) No!
3	f(6)	f(6) Ok
4
List B

Excel 2007
	A	B
1	The bucket e(5) was d(4) full
2	The broom stood
3	The call came d(4)
4
List A

After the new macro in worksheet List A:

Excel 2007
	A	B
1	The bucket e(5) was d(4) full	d(4) Yeah! e(5) No!
2	The broom stood
3	The call came d(4)	d(4) Yeah!
4
List A

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub CompareListsV3()
' hiker95, 02/21/2014, ME759006
Dim b As Variant, a As Variant
Dim i As Long, ii As Long
With Sheets("List B")
  b = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
With Sheets("List A")
  a = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
For i = 1 To UBound(b, 1)
  For ii = 1 To UBound(a, 1)
    If InStr(a(ii, 1), Trim(b(i, 1))) Then
      If a(ii, 2) = "" Then
        a(ii, 2) = b(i, 2)
      ElseIf a(ii, 2) <> "" Then
        a(ii, 2) = a(ii, 2) & " " & b(i, 2)
      End If
    End If
  Next ii
Next i
With Sheets("List A")
  .Cells(1, 1).Resize(UBound(a, 1), UBound(a, 2)) = a
  .Columns(2).AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CompareListsV3 macro.

 

[genius7]

Why so complicated? There is an easy formula that can serve you very well. the range G1:G7 is the list B. The $G$1 would be the first cell of the list B. THe A1 is the first cell of the list A, dont forget to activate the formula by pressing F2 and then ctrl+shift+enter: =IFERROR(=INDEX($G$1:$G$7,MAX(IF(ISERROR(FIND($G$1:$G$7,A1)),-1;1)*(ROW($G$1:$G$7)-ROW($G$1)+1))),"")

 

[jeffsdan]

Actually, hiker95, your macro worked exactly as requested!! You are quite amazing - THANKS!!!

 

[hiker95]

jeffsdan,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[genius7]

And how about my solution?