"on error goto" glitch. How to deal with a consecutive error and ignoring last row command

I am just learning the abc on vba

I have been working with this code, to auto-populate a list based on 2 others. I have a client list, each client has a consultant, I needed to populate the team each client belonged to, and managed to do this using VLookUp application to relate consultant-manager-team.

So when we have a new consultant on board and has not been added to the "consultant-manager" list, obviously, I get an error. I tried fixing it with "On Error Resume Next", but it just populated the cell with the error using the last valid team name and went on. So I inserted a handler (see code below), for it to leave the cell blank and move on, it works fine when there is one error, but when there were 2 continuous errors:

The macro would leave the first one in blank but populated the second cell with an error using the last valid team name.
It keeps populating even after the list ended, ignoring the condition I gave it for the loop (NumRows in code below).

Could any one of you gods guide me on how to redact the error handling process?

Sub populateteam()
    Dim wbFollowUp As Workbook
    Dim wbList As Workbook
    
    Set wbFollowUp = ThisWorkbook
    Set wbList = Workbooks.Open("C:\<folders>\CSTeams.xlsx")
    
    Dim wsAkasaka As Worksheet
    Dim wsList As Worksheet
    
    Set wsAkasaka = wbFollowUp.Worksheets("Akasaka")
    Set wsList = wbList.Worksheets("All Japan")
    
    wbFollowUp.Activate
    
    Dim consultant As String
    Dim manager As String
    Dim team As String
    
    Dim x As Integer
    Application.ScreenUpdating = False
    NumRows = Range("b2", Range("b2").End(xlDown)).Rows.Count
    
    For x = 1 To NumRows    
        consultant = wsAkasaka.Range("b" & (ActiveCell.Row)).Value

        On Error GoTo handler:
        manager = Application.VLookup(consultant, wsList.Range("a13:c250"), 3, False)
        team = Application.VLookup(manager, wsList.Range("e2:F11"), 2, False)
        'The name of the manager in the consultant list and in the team list should be exactly the same,
        'including spaces before and after
        
        If IsEmpty(ActiveCell.Value) Then
            ActiveCell.Value = team
            ActiveCell.Offset(1, 0).Select
        End If
    Next

    Application.ScreenUpdating = True
    
handler:
    ActiveCell.Value = ""
    ActiveCell.Offset(1, 0).Select
    Resume Next
End Sub

Solution

Your error handling is not working as you expect. If you read the documentation of the Resume Statement it says Resume Next does the follwing:

Execution resumes with the statement immediately following the statement that caused the error.

So if an error occured in manager = Application.VLookup(consultant, wsList.Range("a13:c250"), 3, False) because the consultant could not be found. It will resume with the next line which is team = Application.VLookup(manager, wsList.Range("e2:F11"), 2, False) but since manager was not retrieved this runs into the error handler again. And it proceeds again with the *next line which is If IsEmpty(ActiveCell.Value) Then.

So the actual problem is that you use .Select and ActiveCell. You might benefit from reading How to avoid using Select in Excel VBA. Instead of using .Select reference your cells directly (see code below):

Option Explicit

Public populateteam()
    Dim wbFollowUp As Workbook
    Set wbFollowUp = ThisWorkbook
    
    Dim wbList As Workbook
    Set wbList = Workbooks.Open("C:\<folders>\CSTeams.xlsx")
    
    Dim wsAkasaka As Worksheet
    Set wsAkasaka = wbFollowUp.Worksheets("Akasaka")
    
    Dim wsList As Worksheet
    Set wsList = wbList.Worksheets("All Japan")
    
        
    Application.ScreenUpdating = False
    
    Dim LastRow As Long
    LastRow = wsAkasaka.Range("B2").End(xlDown).Row
    
    Dim iRow As Long
    For iRow = 2 To LastRow ' start in row 2 and run to last row if you want to start from the active cells row use `ActiveCell.Row` instead of 2
        Dim consultant As String
        consultant = wsAkasaka.Cells(iRow, "B").Value

        Dim manager As Variant
        manager = Application.VLookup(consultant, wsList.Range("A13:C250"), 3, False)
        
        If Not IsError(manager) Then
            Dim team As Variant
            team = Application.VLookup(manager, wsList.Range("E2:F11"), 2, False)
            'The name of the manager in the consultant list and in the team list should be exactly the same,
            'including spaces before and after
            
            If Not IsError(team) Then
                With wsAkasaka.Cells(iRow, "B")  'replace "B" with the column letter where you want to write your team!
                    If IsEmpty(.Value) Then
                        .Value = team
                    End If
                End With
            End If
        End If
    Next iRow

    Application.ScreenUpdating = True
End Sub

Note that the "B" in the With statement needs to be adjusted to the column where you want to write the team value!

In the code you see I eliminated ActiveCell and .Select entirely by full cell references like wsAkasaka.Cells(iRow, "B").Value it now uses the index iRow from the loop.

Also I removed the error handling and check if the lookup came up with an result (this is more performant than error handling and easier to accomplish). So the code only proceeds with the following step if the lookup was successful. If an error occured it proceeds automatically with the next row Next iRow.

Just a side note. Excel has more rows than Integer can handle. Therefore row counting variables need to be declared Long. Since there is no benefit in using Integer in VBA I recommend always to use Long instead.