Lookup a name and return a value

[most]

Can anyone assist me, fixing this macro? I want it to lookup each name in Sheet1, find it in Sheet2 and return the ID number to Sheet1. The challenge is that the name lookup shouldn't be exact, i.e. "lisa flisa" equals "lisa", so "lisa flisa" would get the ID 20.

*Sheet1*
Column C Column F
Name ID
kalle balle
lisa flisa
arne
lisa flisa

*Sheet2*
Column B Column E
Name ID
arne 10
lisa 20
kalle 30

Sub IterateNames()
    For i = 2 To 65535 Step 1
        c = Sheets("Sheet1").Range("C" & CStr(i)).Value
        If IsEmpty(c) Then Exit For
        Sheets("Sheet1").Range("F" & CStr(i)).Value = LookupName(c)
    Next i
End Sub
Private Function LookupName(ByVal name As String) As Variant
    LookupName = ""
    For i = 2 To 65535 Step 1
        b = Sheets("Sheet2").Range("B" & CStr(i)).Value
        If IsEmpty(b) Then Exit For
               If InStr(1, LCase(CStr(b)), LCase(CStr(name)), vbTextCompare) > 0 Then   'Here is the problem, I think
            LookupName = Sheets("Sheet2").Range("E" & CStr(i)).Value
            Exit For
        End If
    Next i
End Function

I'm using Excel 2010.

 

[most]

Well, it could be a solution to have only one word in Sheet2, but I rather have more than one word in Sheet2. And rather have half words in Sheet2, i.e. "lisa fli" equals "lisa flisa".

 

[Simon Lloyd]

Give this a try:

Sub Assign_id()
    Dim LastRow As Long, oCell As Range
    Dim c As Range
    LastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
    For Each c In Sheets("Sheet1").Range("C2:C" & LastRow)
    If c.Offset(0, 1) = "" Then
    For Each oCell In Sheets("Sheet2").Range("B2:B" & Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row)
    If InStr(c.Value, Left(oCell.Value, Len(c.Value))) > 0 Then
            c.Offset(0, 1).Value = oCell.Offset(0, 1).Value
    End If
    Next oCell
    End If
    Next c
End Sub

 

[most]

Works great! Thanks!
I added "LCase", so it won't be case sensitive.