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.

 

[Simon Lloyd]

why use code rather than vlookup?

 

[Simon Lloyd]

This is untested but should do the job:

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

 

[most]

Almost, it works but it overwrites the result for each iteration, try it with my "debug" line.

Sub Assign_id()
    Dim LastRow As Long, oLastRow As Long
    Dim c As Range, oCell As Range
    LastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
    oLastRow = Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Row
    For Each c In Sheets("Sheet1").Range("C2:C" & LastRow)
        For Each oCell In Sheets("Sheet2").Range("B2:B" & LastRow)
        If LCase(c.Value) Like oCell.Value & "*" Then
            c.Offset(0, [COLOR=Red]3[/COLOR]).Value = oCell.Offset(0, [COLOR=Red]3[/COLOR]).Value
            [COLOR=Red]MsgBox c.Offset(0, 3).Value & oCell.Offset(0, 3).Value 'DEBUG[/COLOR]
        End If
        Next oCell
    Next c
End Sub

Vlookup with "false" parameter doesn't do the job.

 

[Simon Lloyd]

Sorry but it works for me, download this file from my site http://www.thecodecage.com/AssignIds.xls

 

[Simon Lloyd]

Maybe this will be quicker for you

Sub Assign_id()
    Dim LastRow As Long
    Dim c As Range, r 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
    Set r = Sheets("Sheet2").Range("B2:B" & LastRow).Find(What:=c.Value, After:=Sheets("Sheet2").Range("B2"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If r.Value = "" Then GoTo Nxt
            c.Offset(0, 1).Value = r.Offset(0, 1).Value
        End If
Nxt:
    Next c
End Sub

 

[most]

The link doesn't work. I'm not able to get any of your exemples to work, I don't have clue why...

Would be great if you could look at my example file, I added both your examples to it.
http://www.sendspace.com/file/7wcex7

 

[Simon Lloyd]

i removed the file as my second example (above) works much better, have you tried it?

 

[most]

Yes I did, but I get error "Object variable or with block variable not set" for the line "If r.Value = "" Then GoTo Nxt".

I added your script to the attached file above.

 

[Simon Lloyd]

will one sheet always have single word names? if yes then it's an easy fix.