VBA vlookup - Speed the procees up?

[george hart]

The code belowww roks fine in that opens and then looks stuf up. However, as the rows start to increase (to about 200) it takes longer to run. My quesiton, is how can I speed this process up?

Workbooks.Open Filename:= _
"C:\Documents and Settings\HartG\My Documents\Projects\Sickness\Ops Employee LookUp.xls
Windows("Absence Macro-WEST.xls").Activate
Dim X As Variant
For X = 4 To Cells(Rows.Count, "B").End(xlUp).Row
Dim myRange As Range
Set myRange = Workbooks("Ops Employee LookUp.xls").Worksheets("Lookup Table").Range("B:Z")
On Error Resume Next 'Stops Macro from falling over on completion of vlookup
'Dim Answer As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'Line Manager1
Worksheets("Absence Reporting").Range("D" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 2, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("D" & X).Value = "Emlpoyee not found"
'E-mail1
Worksheets("Absence Reporting").Range("E" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 3, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("E" & X).Value = ""
'Line Manager2
Worksheets("Absence Reporting").Range("F" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 4, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("F" & X).Value = ""
'E-mail2
Worksheets("Absence Reporting").Range("G" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 5, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("G" & X).Value = ""
'Line Manager3
Worksheets("Absence Reporting").Range("H" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 6, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("H" & X).Value = ""
'E-mail3
Worksheets("Absence Reporting").Range("I" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 7, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("I" & X).Value = ""
'Line Manager4
Worksheets("Absence Reporting").Range("J" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 8, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("J" & X).Value = ""
'E-mail4
Worksheets("Absence Reporting").Range("K" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 9, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("K" & X).Value = ""

'Line Manager5
Worksheets("Absence Reporting").Range("L" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 10, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("L" & X).Value = ""
'E-mail5
Worksheets("Absence Reporting").Range("M" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 11, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("M" & X).Value = ""
'Grade
Worksheets("Absence Reporting").Range("N" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 12, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("N" & X).Value = ""
'Depot
Worksheets("Absence Reporting").Range("O" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 13, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("O" & X).Value = ""
'Region
Worksheets("Absence Reporting").Range("P" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 14, False)
If Err.Number <> 0 Then Worksheets("Absence Reporting").Range("P" & X).Value = ""

'MsgBox if line manager not found
If Worksheets("Absence Reporting").Range("D" & X).Value = _
"Emlpoyee not found" Then MsgBox "Line Manager for " & _
Worksheets("Absence Reporting").Range("B" & X).Value & _
" not found - Please advise the employee table owner by selecting"

'Line Manager/s
Worksheets("Absence Reporting").Range("C" & X).Value = _
Worksheets("Absence Reporting").Range("D" & X) & " " & _
Worksheets("Absence Reporting").Range("F" & X) & " " & _
Worksheets("Absence Reporting").Range("H" & X) & " " & _
Worksheets("Absence Reporting").Range("J" & X) & " " & _
Worksheets("Absence Reporting").Range("L" & X)

Next
Windows("Ops Employee LookUp.xls").Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Many thanks

 

[ISY]

Hello try this:

Workbooks.Open Filename:="C:\Documents and Settings\HartG\My Documents\Projects\Sickness\Ops Employee LookUp.xls"
Windows("Absence Macro-WEST.xls").Activate
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.EnableEvents = False
Dim X As Variant
Dim myRange As Range
Set myRange = Workbooks("Ops Employee LookUp.xls").Worksheets("Lookup Table").Range("B:Z")
With Worksheets("Absence Reporting")
For X = 4 To Cells(Rows.Count, "B").End(xlUp).Row
On Error Resume Next 'Stops Macro from falling over on completion of vlookup
'Dim Answer As String
'Line Manager1
.Range("D" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 2, False)
If Err.Number <> 0 Then .Range("D" & X).Value = "Emlpoyee not found"
'E-mail1
.Range("E" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 3, False)
If Err.Number <> 0 Then .Range("E" & X).Value = ""
'Line Manager2
.Range("F" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 4, False)
If Err.Number <> 0 Then .Range("F" & X).Value = ""
'E-mail2
.Range("G" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 5, False)
If Err.Number <> 0 Then .Range("G" & X).Value = ""
'Line Manager3
.Range("H" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 6, False)
If Err.Number <> 0 Then .Range("H" & X).Value = ""
'E-mail3
.Range("I" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 7, False)
If Err.Number <> 0 Then .Range("I" & X).Value = ""
'Line Manager4
.Range("J" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 8, False)
If Err.Number <> 0 Then .Range("J" & X).Value = ""
'E-mail4
.Range("K" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 9, False)
If Err.Number <> 0 Then .Range("K" & X).Value = ""

'Line Manager5
.Range("L" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 10, False)
If Err.Number <> 0 Then .Range("L" & X).Value = ""
'E-mail5
.Range("M" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 11, False)
If Err.Number <> 0 Then .Range("M" & X).Value = ""
'Grade
.Range("N" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 12, False)
If Err.Number <> 0 Then .Range("N" & X).Value = ""
'Depot
.Range("O" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 13, False)
If Err.Number <> 0 Then .Range("O" & X).Value = ""
'Region
.Range("P" & X).Value = _
Application.WorksheetFunction.VLookup(Range("B" & X), myRange, 14, False)
If Err.Number <> 0 Then .Range("P" & X).Value = ""

'MsgBox if line manager not found
If .Range("D" & X).Value = _
"Emlpoyee not found" Then MsgBox "Line Manager for " & _
.Range("B" & X).Value & _
" not found - Please advise the employee table owner by selecting"

'Line Manager/s
.Range("C" & X).Value = _
.Range("D" & X) & " " & _
.Range("F" & X) & " " & _
.Range("H" & X) & " " & _
.Range("J" & X) & " " & _
.Range("L" & X)

Next
End With
Windows("Ops Employee LookUp.xls").Close
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.EnableEvents = True

 

[RoryA]

Try this:

   Dim wbkLookup As Workbook
   Dim wbkThis As Workbook
   Dim wksReport As Worksheet
   Dim myRange As Range
   Dim X As Long
   Dim varMatch
   Set wbkThis = Workbooks("Absence Macro-WEST.xls")
   Set wksReport = wbkThis.Worksheets("Absence Reporting")
   Set wbkLookup = Workbooks.Open(Filename:= _
                                  "C:\Documents and Settings\HartG\My Documents\Projects\Sickness\Ops Employee LookUp.xls")
   wbkThis.Activate
   'Dim Answer As String
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Application.EnableEvents = False
   Set myRange = wbkLookup.Worksheets("Lookup Table").Range("B:Z")
   For X = 4 To Cells(Rows.Count, "B").End(xlUp).Row
      varMatch = Application.Match(Range("B" & X).Value, myRange.Columns(1), 0)
      With wksReport
         If Not IsError(varMatch) Then
            'Line Manager1
            .Range("D" & X).Resize(, 13).Value = myRange.Cells(varMatch, 2).Resize(, 13).Value
         Else
            .Range("D" & X).Value = "Employee not found"
            .Range("E" & X).Resize(, 12).Value = ""
            'MsgBox if line manager not found
            MsgBox "Line Manager for " & .Range("B" & X).Value & _
                   " not found - Please advise the employee table owner by selecting"
         End If
         'Line Manager/s
         .Range("C" & X).Value = _
         .Range("D" & X) & " " & _
         .Range("F" & X) & " " & _
         .Range("H" & X) & " " & _
         .Range("J" & X) & " " & _
         .Range("L" & X)
      End With
   Next X
   
   wbkLookup.Close
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   Application.EnableEvents = True
End Sub