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
CodePudding user response:
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 theWith
statement needs to be adjusted to the column where you want to write theteam
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.
CodePudding user response:
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:
- The line
manager = Application.VLookup(consultant, wsList.Range("a13:c250"), 3, False)
will throw an error. Note that the value ofmanager
will NOT update, and will therefore stay as the value it was previously. - Your code goes through the
handler
block, populate the cell with "", move to the next cell down, and then thatResume Next
line takes you directly toteam = Application.VLookup(manager, wsList.Range("e2:F11"), 2, False)
- Now, the value of
manager
is the same as it was in the last run, so the value ofteam
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