Finding matching strings in a column
I solved the problem. Here is the code: 

Set rngSearch = Sheets("Sheet1").Range("D:D")
For Each rngSearch In Drng
    'all activities are searched in Arng:
    Set rFnd = Sheets("Sheet1").Range("D2:D" &amp; lastRowD).Find(What:=sText, LookAt:=xlPart)
    Set rngFound = Arng.Find(What:=rngSearch, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

    If Not rFnd Is Nothing Then
        rngSearch.Offset(0, 0) = rngSearch.Offset(-1, 0) 'if found multiple strings, don't loop column A but copy the row above
    Else
        'if activity is found:
        If Not rngFound Is Nothing Then
            rngSearch.Offset(0, 0) = rngFound.Offset(0, 1)
        Else
            rngSearch.Offset(0, 0) = "0"
        End If
    End If
Next