Count and Highlight keywords within phrases

I have an excel sheet with two columns. The first column is the key phrase and the second is the messages. The key phrase may occur in the messages column. I need to know how many times a key phrase has occurred in messages column. please suggest some good and easy way of finding.

The key phrase is one column and the messages is the second column. The messages column is combination (concatenation) of 1 or more than 1 key phrases. I need to find out that how many key phrases does each message contain.


It's possible that you might be able to collect an efficient count with a module sub procedure that performs all of the maths in memory arrays¹ and returns the counts to the worksheet.

      Counts keywords in phrases sample data

I've used some standard Lorem Ipsum keywords and phrases to create the above sample data.

Tap Alt+F11 and when the VBE opens, immediately use the pull-down menus to Insert ► Module (Alt+I,M). Paste the following into the new module code sheet titled something like Book1 - Module1 (Code).

Option Explicit

Sub count_strings_inside_strings()
    Dim rw As Long, lr As Long
    Dim k As Long, p As Long, vKEYs As Variant, vPHRASEs As Variant, vCOUNTs As Variant

    ReDim vKEYs(0)
    ReDim vPHRASEs(0)

    With Worksheets("Sheet1")   '<~~ set to the correct worksheet name\
        'populate the vKEYs array
        For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            vKEYs(UBound(vKEYs)) = LCase(.Cells(rw, 1).Value2)
            ReDim Preserve vKEYs(UBound(vKEYs) + 1)
        Next rw
        ReDim Preserve vKEYs(UBound(vKEYs) - 1)

        'populate the vPHRASEs array
        For rw = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            vPHRASEs(UBound(vPHRASEs)) = LCase(.Cells(rw, 2).Value2)
            ReDim Preserve vPHRASEs(UBound(vPHRASEs) + 1)
        Next rw
        ReDim Preserve vPHRASEs(UBound(vPHRASEs) - 1)
        ReDim vCOUNTs(0 To UBound(vPHRASEs))

        'perform the counts
        For p = LBound(vPHRASEs) To UBound(vPHRASEs)
            For k = LBound(vKEYs) To UBound(vKEYs)
                vCOUNTs(p) = CInt(vCOUNTs(p)) + _
                    (Len(vPHRASEs(p)) - Len(Replace(vPHRASEs(p), vKEYs(k), vbNullString))) / Len(vKEYs(k))
            Next k
        Next p

        'return the counts to the worksheet
        .Cells(2, 3).Resize(UBound(vCOUNTs) + 1, 1) = Application.Transpose(vCOUNTs)

        'run the helper procedure to Blue|Bold all of the found keywords within the phrases
        Call key_in_phrase_helper(vKEYs, .Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp)))

    End With
End Sub

Sub key_in_phrase_helper(vKYs As Variant, rPHRSs As Range)
    Dim p As Long, r As Long, v As Long

    With rPHRSs
        For r = 1 To rPHRSs.Rows.Count
            .Cells(r, 1) = .Cells(r, 1).Value2
            For v = LBound(vKYs) To UBound(vKYs)
                p = 0
                Do While CBool(InStr(p + 1, .Cells(r, 1).Value2, vKYs(v), vbTextCompare))
                    p = InStr(p + 1, .Cells(r, 1).Value2, vKYs(v), vbTextCompare)
                    Debug.Print vKYs(v)
                    With .Cells(r, 1).Characters(Start:=p, Length:=Len(vKYs(v))).Font
                        .Bold = True
                        .ColorIndex = 5
                    End With
                Loop
            Next v
        Next r
    End With
End Sub

You may have to rename the worksheet to be processed in the 5th code line. I've also included a helper routine that identifies the key words within the phrases with a Blue|Bold font. Comment out or delete the Call key_in_phrase_helper(...) line at the bottom of the first sub procedure if this is not desired.

Tap Alt+Q to return to your worksheet. Tap Alt+F8 to open the Macros dialog and Run the sub procedure. If you data resembles the sample data I've put together then you should have similar results.

      Counts keys in phrases


¹ These are some advanced methods but I feel that they are also the best way to tackle your problem. If you have specific questions that your own research does not adequately explain, I will try to address them in the Comments section. The sample workbook I created to create this solution can be made available on request.