El código que planteas va por buen camino, así que aquí te brindo una mano con algunos ajustes sobre él:
Function DEVUELVE(rango As Range, celda As Range) As Variant
Dim palabra As Range
For Each palabra In rango.Columns(1).Cells
If InStr(1, celda.Value, palabra.Value) > 0 Then
DEVUELVE = Application.WorksheetFunction.VLookup(palabra.Value, rango, 2, False)
Exit Function
End If
Next palabra
DEVUELVE = "???"
End Function
De esta forma, el código va a buscar el texto del segundo argumento de la función en el rango del primer argumento de la misma. Si el hallazgo es verdadero, te va a entregar el valor de la enésima celda de la columna colindante, si no, te va a devolver '???'. Llámala usando:
=DEVUELVE(rango, palabra)
Espero que te sea útil.