VBA double for Loop running very slowly

Question

The following macro is created to match employee names to badge numbers. It needs to be in excel and not access. There are two sheets in the workbook. "All" tracks the first name, second name, and other information. This workbooks is about 8000 rows at present and growing. "EmpCon List" (Employer / Contractor) is a database of their first name, second name and badge number and has a stable amount of rows about 450. There is a data validation between All and Emp Con so their names must match perfectly

The macro is designed to match the first and second name in "All" against the first name in "EmpCon List", and then match it to a badge number which is to appear in "All".

The macro appears to be logical, a double For loop. However, the program does not respond correctly and "whites out" after a few seconds of running. Is there a way to help VBA process this?

Sub BadgeNumberLookUp()

Dim i As Integer, j As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets("All").Select ' Job Number page
JobRows = Application.CountA(Range("A:A")) + 10 ' This number is 8000 and growing


Sheets("EmpCon List").Select 'Employee / Contractors sheet
EmployeeCount = Application.CountA(Range("M:M")) + 10 ' This number is about 450 and stable

For i = 1 To JobRows
    Sheets("All").Select
    jobPrenom = Cells(i, 1).Value
    jobSurname = Cells(i, 2).Value
    For j = 1 To EmployeeCount
        Sheets("EmpCon List").Select
        prenom = Cells(j, 13).Value
        surname = Cells(j, 14).Value
        indexNo = Cells(j, 12).Value
        badgeNumber = Cells(j, 15).Value
        ' Use UCase as sometimes the names are not always in lower/uppercase
        If UCase(prenom) = UCase(jobPrenom) And UCase(surname) = UCase(jobSurname) Then
            Sheets("All").Select
            Cells(i, 16).Value = badgeNumber
            Exit For
        End If
    Next j
Next i

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

I highly recommend reading through ["How to avoid using `.Select` or `.Activate`](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros), this will cause a lot of slow downs (especially as you set values, and such). — BruceWayne, Feb 19 '16 at 16:30
Does this code work just run slowly? Working code is off-topic at SO but the guys at CodeReview would probably help you. @Mat'sMug — Chrismas007, Feb 19 '16 at 16:37
Thank you Bruce, I'm changing it now and will test performance shortly. — Iorek, Feb 19 '16 at 16:38
You can do this with a formula as well, and eliminate the VBA. Assuming First and Last Name are in columns A and B for both sheets, use this **array** formula in the Badge column in the All Sheet `=INDEX('EmpCon List'!C:C,MATCH(A2&B2,'EmpCon List`!A:A&'EmpCon List'!B:B,0))` and make sure to press **Ctrl + Shift + Enter** when exiting cell edit mode. — Scott Holtzman, Feb 19 '16 at 16:40
Hi Scott, I've been using excel formulas so far, but they are getting wiped and destroyed as I filter and run other people's macros on this file. Cheers! — Iorek, Feb 19 '16 at 16:42
I know you selected it as the answer, but was it just the use of `.Select` that was throwing it off? — BruceWayne, Feb 19 '16 at 17:04

score 4 · Accepted Answer · answered Feb 19 '16 at 16:34

Not the solution (AFAIK), but I just wanted to show you how to cut down your code (and any potential pitfalls with .Select). This should do the same. Note how I created two worksheet variables, and then qualified the ranges with the sheet the info is coming from.

Sub BadgeNumberLookUp_No_Select()
Dim i As Integer, j As Integer
Dim empConWS As Worksheet, allWS As Worksheet

Set empConWS = Sheets("EmpCon List")
Set allWS = Sheets("All")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Sheets("All").Select ' Job Number page
JobRows = Application.CountA(allWS.Range("A:A")) + 10 ' This number is 8000 and growing


'Sheets("EmpCon List").Select 'Employee / Contractors sheet
EmployeeCount = Application.CountA(empConWS.Range("M:M")) + 10 ' This number is about 450 and stable


For i = 1 To JobRows
    'Sheets("All").Select
    With allWS
    jobPrenom = .Cells(i, 1).Value
    jobSurname = .Cells(i, 2).Value
   End with
    For j = 1 To EmployeeCount
        'Sheets("EmpCon List").Select
        With empConWS
            prenom = .Cells(j, 13).Value
            surname = .Cells(j, 14).Value
            indexNo = .Cells(j, 12).Value
            badgeNumber = .Cells(j, 15).Value
        End With
        ' Use UCase as sometimes the names are not always in lower/uppercase
        If UCase(prenom) = UCase(jobPrenom) And UCase(surname) = UCase(jobSurname) Then
            'Sheets("All").Select
            allWS.Cells(i, 16).Value = badgeNumber
            Exit For
        End If
    Next j
Next i

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Run this and see if the same errors occur for you.

VBA double for Loop running very slowly

1 Answers1