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.
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.
¹ 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.