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

Question

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:

1. The macro would leave the first one in blank but populated the second cell with an error using the last valid team name.
2. 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

Answer 1

If you step through your code line-by-line you can find these issues yourself. In fact, whenever error handling isn't working as you expect it to, you should step through your code line-by-line to see exactly what is happening.

For your first issue,

The macro would leave the first one in blank but populated the second cell with an error using the last valid team name.

Think about what's happening as your code runs when you have a new consultant:

1. The line manager = Application.VLookup(consultant, wsList.Range("a13:c250"), 3, False) will throw an error. Note that the value of manager will NOT update, and will therefore stay as the value it was previously.
2. Your code goes through the handler block, populate the cell with "", move to the next cell down, and then that Resume Next line takes you directly to team = Application.VLookup(manager, wsList.Range("e2:F11"), 2, False)
3. Now, the value of manager is the same as it was in the last run, so the value of team will be the same as it was last run.

I'm a little confused by your If IsEmpty(ActiveCell.Value) Then loop, so this advice might not be what you're trying to accomplish, but I recommend adding an Else clause to your If statement, and then moving the line team = Application.VLookup(manager, wsList.Range("e2:F11"), 2, False) under that Else clause. This will only write the team to a cell when the manager value value was updated with an existing consultant.

As for your second issue,

It keeps populating even after the list ended, ignoring the condition I gave it for the loop (NumRows in code below).

have you checked the value of NumRows? This line Range("b2", Range("b2").End(xlDown)).Rows.Count has a value much larger than you think it should be: over 1 million