(1) -My data set is a long list therefore it should insert a row for each matched function then copy/paste data to the new rows from the row number where string data belongs to and it should loop this for entire list. If there is no match then it shouldn't insert a row and should follow the same rule for next record - Is this possible ?
(2) - Also there are some mismatched functions which miscalculates count of functions for Abs, Clear, Collect, Refresh, Sort, Update, Value. I made notes in Notes worksheet attached with sample data set.
(1) - not following what you mean
(2) - I used InStr and it matched substrings also, so CLEAR counted CLEAR, CLEARDATA, and CLEARCOLLECT. Messed up the numbers
Switched to a slightly more complicated algorithm so it seems more better
Option Explicit
Sub Clear()
With Worksheets("Sample")
Range(.Range("G2"), .Range("G2").End(xlDown)).Resize(, 4).ClearContents
Range(.Range("A3"), .Range("A3").End(xlDown)).Resize(, 5).ClearContents
End With
End Sub
Sub ClearCollect()
Dim sInput As String, sTemp As String
Dim aryKeys As Variant, aryWords As Variant
Dim rLookup As Range
Dim i As Long, j As Long, iOut As Long
Application.ScreenUpdating = False
Clear
'init
sInput = Worksheets("Sample").Range("F2").Value
sInput = UCase(sInput)
Set rLookup = Worksheets("Lookup").Cells(1, 1).CurrentRegion
aryKeys = Application.WorksheetFunction.Transpose(rLookup.Columns(1).Value)
ReDim aryCount(LBound(aryKeys) To UBound(aryKeys))
'remove non-alpha char from input string
For i = 1 To Len(sInput)
Select Case Mid(sInput, i, 1)
Case "A" To "Z"
sTemp = sTemp & Mid(sInput, i, 1)
Case Else
sTemp = sTemp & " "
End Select
Next i
Do While InStr(sTemp, " ") > 0
sTemp = Replace(sTemp, " ", " ")
Loop
aryWords = Split(sTemp, " ")
'count number occurances
For i = LBound(aryKeys) To UBound(aryKeys)
aryKeys(i) = UCase(aryKeys(i))
For j = LBound(aryWords) To UBound(aryWords)
If aryWords(j) = aryKeys(i) Then aryCount(i) = aryCount(i) + 1
Next j
Next i
'if num occurances > 0 then write to output sheet
iOut = 2
For i = LBound(aryCount) To UBound(aryCount)
If aryCount(i) > 0 Then
With Worksheets("Sample")
.Cells(iOut, 1).Value = Worksheets("Sample").Range("A2").Value
.Cells(iOut, 2).Value = Worksheets("Sample").Range("B2").Value
.Cells(iOut, 3).Value = Worksheets("Sample").Range("C2").Value
.Cells(iOut, 4).Value = Worksheets("Sample").Range("D2").Value
.Cells(iOut, 7).Value = rLookup.Cells(i, 1).Value
.Cells(iOut, 8).Value = rLookup.Cells(i, 2).Value
.Cells(iOut, 9).Value = rLookup.Cells(i, 3).Value
.Cells(iOut, 10).Value = aryCount(i)
End With
iOut = iOut + 1
End If
Next i
Application.ScreenUpdating = True
MsgBox "Done"
End Sub