Member Avatar for Jeffrey_1

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)

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

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

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

Final Product: What I need the final product to look like:

Coumn A - from List A       Column B - Added text from List B 
The bucket e(5) was full    e(5) No!
The broom stood 
The call came d(4)          d(4) Yeah
Edited by Jeffrey_1
  • 1 Contributor
  • 1 Reply
  • 230 Views
  • 1 Hour Discussion Span
  • Latest Post Latest Post by Jeffrey_1

Dani AI

Generated

A practical approach is to build a lookup (dictionary) from List B and then scan each cell in List A for any of those keys. As clarified, some cells may contain multiple notations, so the routine should collect every match found, remove duplicates, and write the associated List B values into List A Column B joined with a chosen separator (for example " / " or a line break).

Two common strategies:

  • Simple nested loop with InStr: easiest to implement and fine for small lists, but O(N*M) and slow when both lists are large.
  • Single regular-expression pass: build one regex alternation from all escaped keys, execute it against each List A cell (IgnoreCase), then map each match back to the dictionary. This is faster and cleanly returns multiple matches per cell. To avoid partial/substring hits, escape regex metacharacters and sort keys by length (longer keys first) when building the alternation.

The sample VBA below uses late binding (no extra References required), creates a Scripting.Dictionary from List B, runs a global RegExp against List A cells, collects unique results in the order found, and writes them to the adjacent cell. Change sheet/range names and the output separator as needed.

Sub MapListBToListA()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1") ' adjust
    Dim rngA As Range, rngB As Range
    Set rngA = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    Set rngB = ws.Range("D2:E" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row) ' keys in D, values in E

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim c As Range, i As Long
    For Each c In rngB.Columns(1).Cells
        If Len(Trim(c.Value)) > 0 Then dict(UCase(Trim(c.Value))) = Trim(c.Offset(0, 1).Value)
    Next

    If dict.Count = 0 Then Exit Sub

    Dim keys() As String: ReDim keys(dict.Count - 1)
    i = 0
    Dim k As Variant
    For Each k In dict.Keys
        keys(i) = RegexEscape(CStr(k))
        i = i + 1
    Next
    Call SortByLengthDesc(keys)

    Dim re As Object: Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "(" & Join(keys, "|") & ")"
    re.Global = True: re.IgnoreCase = True

    Dim matches As Object, m As Object
    For Each c In rngA.Cells
        If Len(Trim(c.Value)) > 0 Then
            Set matches = re.Execute(CStr(c.Value))
            If matches.Count > 0 Then
                Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary")
                Dim resultsCol As Collection: Set resultsCol = New Collection
                For Each m In matches
                    Dim v As String: v = dict(UCase(CStr(m.Value)))
                    If Not seen.Exists(v) Then seen.Add v, True: resultsCol.Add v
                Next
                Dim out As String, idx As Long
                For idx = 1 To resultsCol.Count
                    If idx > 1 Then out = out & " / " ' change to vbNewLine for in-cell break
                    out = out & resultsCol(idx)
                Next
                c.Offset(0, 1).Value = out
            End If
        End If
    Next
End Sub

Private Function RegexEscape(ByVal s As String) As String
    Dim specials As String: specials = "\^$.|?*+()[]{}"
    Dim out As String, i As Long, ch As String
    For i = 1 To Len(s)
        ch = Mid$(s, i, 1)
        If InStr(specials, ch) > 0 Then out = out & "\" & ch Else out = out & ch
    Next
    RegexEscape = out
End Function

Private Sub SortByLengthDesc(arr() As String)
    Dim i As Long, j As Long, tmp As String
    For i = LBound(arr) To UBound(arr)
        For j = i + 1 To UBound(arr)
            If Len(arr(j)) > Len(arr(i)) Then tmp = arr(i): arr(i) = arr(j): arr(j) = tmp
        Next
    Next
End Sub

Notes and cautions: keep keys trimmed and uppercase in the dictionary to make lookup case-insensitive; adjust the separator string to use a line break (vbNewLine) if Excel cells are wrapped; for very large data sets, preprocess or limit the regex alternation size to avoid engine limits.

Member Avatar for Jeffrey_1

Just realized that some cells have more that one notation in them as well, such as the first line below, so those cells would need to post the result with either a "/" or an in-cell paragraph break to include both associated values in the cell (again, like the below output). Thoughts?

List A

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

Output

Coumn A - from List A           Column B - Added text from List B 
The bucket e(5) was full f(6)   e(5) No! / f(6) Ok
The broom stood 
The call came d(4)              d(4) Yeah
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.