VBA Code - Compare and populate Keywords with comma delimiter

pete2020 · Apr 30th 2020

I would be more Thankful if you Provide a solution for the Issue which is taking a longer time to do Manually.

Based on Column A the column B is sheet 2 to be matched against sheet 1 Column B

Match Criteria

-------------

Sheet2 Column A should Match with Sheet 1 of Column A - Exact Match

Sheet 2 Column B should match aganist column B and C in Sheet 1 - partial Match

Sheet 2 Column B and C has multiple variations of Keywords with comma separated

Match with Plural words for the each Keyword: for Example as for business it should match “Es”

If None of the Keywords matched it should display as Not found

Match should not be case sensitive

All the matched pairs should be populated in Column C and Column D of sheet 1 with comma delimiter

All the adjacent rows From Column D to L of sheet 2 be populated to sheet 1 with comma separated (Only Populate Unique Words with comma delimiter)

While comparing column B key words it should consider exact space match " Co mplete" or "Com plete"

I need to compare 100k rows in sheet1 with almost 400 pairs of keywords of sheet 2

Please find the attached excel

dangelor · Apr 30th 2020

Possibly...?

Code

Sub test()
    Dim v1 As Variant, v2 As Variant
    Dim i As Long, j As Long
    
    v1 = ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).CurrentRegion
    v2 = ThisWorkbook.Worksheets("Sheet2").Cells(1, 1).CurrentRegion
    Debug.Print
    For i = 1 To UBound(v1)
        For j = LBound(v2) To UBound(v2)
            If v1(i, 1) = v2(j, 1) Then
                If v1(i, 2) Like "*" & v2(j, 2) & "*" And v2(j, 2) <> "" Or v1(i, 2) Like "*" & v2(j, 3) & "*" And v2(j, 3) <> "" Then
                    v1(i, 4) = v2(j, 2) & ", " & v2(j, 3)
                    v1(i, 5) = v2(j, 5)
                    Exit For
                Else
                    v1(i, 4) = "Not Found"
                    v1(i, 5) = ""
                End If
            End If
        Next j
    Next i
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).CurrentRegion = v1
End Sub

Display More

pete2020 · Apr 30th 2020

Thank You for providing me a Macro.unfortunetly The macro seems not working and giving me a error.

v1 = ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).CurrentRegion

v2 = ThisWorkbook.Worksheets("Sheet2").Cells(1, 1).CurrentRegion

Please help me Out

dangelor · Apr 30th 2020

Three assumptions were made:

1. The data is in Worksheets named "Sheet1" and "Sheet2"

2. The data in both worksheets begin in the top left cell "A1"

3. The code is placed in a standard code module in the same workbook as the worksheets

If these assumptions are good, then I would need to know the complete error description.

dangelor · Apr 30th 2020

See attached file

Search and Match Sample data1.xlsm

pete2020 · Apr 30th 2020

Thank You for helping out.

The Code is partially working fine, But found few flaws to fix in the macro

1. Macro HAS TO Excluding the keywords in Column C sheet 2 while searching in column A

(Please Check Row 2 in sheet 2 - comparing aganist Row 4 and 5) - Both are different -Actually Row 4 does not fall under Retargeting KW

2. Macro HAS TO considering plurals for keywords for Column B keywords

(Given the code model below to indentify plurals for keywords)

3. Macro HAS TO considering Multiple words (mentioned in comma) in column B

(ex: Chat Bots, Chatbots (Row 4 in sheet2 should match for Row 2 and Row 6 in sheet 1)

4.Macro has to compare across the full range of respective column data in sheet 1 and 2

For Plurals search criteria please modify the below condition this as per our keyword search criteria

For Each X In d.Keys

For Each z In ary

If InStr(1, X, " " & z & " ", 1) + InStr(1, X, " " & z & "s ", 1) + InStr(1, X, " " & z & "es ", 1) = 0 Then

d.Remove X: Exit For

End If

dangelor · May 2nd 2020

Try this version...

Code

Sub Search_and_Match2()
    Dim v As Variant, w As Variant
    Dim Arr As Variant, A As Variant
    Dim i As Long, j As Long
    Dim d As Object, s As String

    With ThisWorkbook.Worksheets("Sheet2")
        
        'get Keywords
        Set d = CreateObject("Scripting.Dictionary")
        v = Intersect(.Cells(1, 1).CurrentRegion, .Columns(2)).Offset(1)
        For i = LBound(v, 1) To UBound(v, 1)
            Arr = Split(v(i, 1), ",")
            For Each A In Arr
                d(A) = Trim(d(A))
            Next A
        Next i
        
        'exclude keywords
        v = Intersect(.Cells(1, 1).CurrentRegion, .Columns(3)).Offset(1)
        For i = LBound(v, 1) To UBound(v, 1)
            Arr = Split(v(i, 1), ",")
            For Each A In Arr
                d.Remove (A)
            Next A
        Next i
        w = Intersect(.Cells(1, 1).CurrentRegion, .Columns(1))
    End With
    
    'find match
    With ThisWorkbook.Worksheets("Sheet1")
        v = .Cells(1, 1).CurrentRegion
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = w(i, 1) Then
                Arr = Split(v(i, 2))
                For Each A In Arr
                    For j = 0 To d.Count - 1
                        If InStr(1, A, d.Keys()(j), 0) > 0 And Len(A) = Len(d.Keys()(j)) Then
                            s = s & d.Keys()(j) & ", "
                        End If
                    Next j
                Next A
                If Len(s) > 0 Then
                    v(i, 4) = Left(s, Len(s) - 2)
                    s = ""
                Else
                    v(i, 4) = "Not Found"
                End If
            End If
        Next i
        .Cells(1, 1).CurrentRegion = v
    End With
End Sub

Display More

I could not incorporate your code for including plurals - there is no definition for "ary"

pete2020 · May 2nd 2020

Dangelor, Thank You for modifying the macro.

The Macro needs some fixes

1. The Sheet2 Column E data is not Populated in sheet1 with comma seperated - based on keyword match

2. The excluded words are not considered while find and match

3. In sheet 2 , Column B comma seperated keywords are not functioning well within the macro.

Please run on the sample file

VBA Code - Compare and populate Keywords with comma delimiter

Participate now!

Share

Tags