For Each loop not going through all the data

Question

I have a simple macro that goes through a series of sheets, gathering names based on a data inputted, then puts it all in a nicely formatted Word document. I have most of it figured out, but one bug is annoying me. It has to do with the code that gets the cell phone number based on the name. Here is the function:

Function findCell(namePerson As String) As String
    Dim splitName As Variant
    Dim lastName As String
    Dim firstName As String

    splitName = Split(namePerson, " ")
    lastName = splitName(UBound(splitName))
    ReDim Preserve splitName(UBound(splitName) - 1) 
    firstName = Join(splitName)

    For Each b In Worksheets("IT").Columns(1).Cells
        If b.Value = lastName Then
            If Sheets("IT").Cells(b.row, 2).Value = firstName Then findCell = Sheets("IT").Cells(b.row, 4).Value
        End If
    Next
End Function

The cellphone numbers are on its own sheet called "IT". The first column has the last name, the second column has the first name, and the forth column has the cell phone number. Some people have multiple parts for the first name, and that's why you see some of that weird splitting, ReDim-ing and joining back together. That part works just fine.

The problem arises when you have multiple people with the same last name. The function would find someone with the right last name, going through the first If statement. Then it would compare the first name. If it matches, it would return the value of the cell phone number like it should. After that, the for loop stops, even if the first name doesn't match up. So if someone happens to the same last name, but the first name doesn't check up, it returns nothing.

I've tried putting the return call outside of the loop all together, and it still doesn't make a difference.

Answer 1

Since you're not using a database, a primary key column might be difficult. With your current set up you could try this. It

• doesn't look through every single cell in the column
• uses Option Explicit
• will return the first find and exit
• will be indifferent to upper/lower case and leading/trailing white space.

.

Option Explicit

Function findCell(namePerson As String) As String
    Dim splitName As Variant
    Dim lastName As String
    Dim firstName As String

    splitName = Split(namePerson, " ")
    lastName = splitName(UBound(splitName))
    ReDim Preserve splitName(UBound(splitName) - 1)
    firstName = Join(splitName)

    Dim ws As Worksheet, lastrow As Long, r As Long
    Set ws = Worksheets("IT")
    lastrow = ws.Cells(1, 1).End(xlDown).Row 'or whatever cell is good for you

    For r = 1 To lastrow
        If UCase(Trim(ws.Cells(r, 1))) = UCase(Trim(lastName)) _
            And UCase(Trim(ws.Cells(r, 2))) = UCase(Trim(firstName)) Then

            findCell = ws.Cells(r, 4)
            Exit For
        End If

    Next r

End Function

Answer 2

It seems like you're postponing dealing with the real issue by trying to fix this one.

You're running into issues because your "keys" (name) aren't unique. You've worked around one naming clash, and now you're trying to work around another one.

What about getting a key (like a GUID) that you know will be unique? Then there won't be the need to work around this any more.