I'm not an expert, but how about using the INSTR function: Instr([start], string, substring, [compare])
Assuming that the strings in 'grants' are comma-separated,...maybe something in that direction:
Dim i as long, j as long
Dim numCounter as long: numCounter = 0
Dim rng as range: set rng = Worksheets("grants").range("B2:B16")
Dim arr as variant: arr = rng
Dim arrSplit as variant
Dim str as string: str = Worksheets("applciations").range("B2").text
For i = Lbound(arr,1) to Ubound(arr, 1)
Redim arrSplit = Split(arr(i,1), " , ")
For j = Lbound(arrSplit,1) to Ubound(arrSplit, 1)
If Instr(1, arrSplit(j,1), str, vbTextCompare) > 0 Then
numCounter = numCounter + 1
End if
next j
If numCounter = 3 then
Worksheets("applications").Range("C2") = rng.cells(i,2)
numCounter = 0
End if
Exit for
Next i