do vlookups in loops slow things down? IF so how to speed up

miless2111s

Active Member
Joined
Feb 10, 2016
Messages
279
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Background:
I have a complex worksheet that I am turning into code so that I can attempt to protect the calculations with VBA obscuring. This has resulted in a macro which loops around 1000 times and has a significant number of vlookups built in. It gathers information from the looks up, performs calculations as required and then outputs the results to the display sheet which has c. 1000 rows in at the moment however this will eventually grow to around 2000.

The vlookups are looking into 5 or more distinct tables of data:
Dates 2x2000 columns x rows
Rows 2x80
Data 10x 250
Colours 12 x possibly lots but usually less than 50
Definitions 10 x400I

Issue:
Running the code works a charm and does the job however it takes rather a long time to run (around a minute) and so far I've only dealt with 50% of the calculations. As I will be setting the macro to run when the workbook is closed and saved this delay will be uncomfortable and slows the whole process down.

Help needed:
Is there some way to either speed up the Vlookup process or a technique to pre-load all the information into the code and then the code uses something other than vlookup to fetch the required information?

Many thanks

Miles
 
OK, I've run all the methods 50, 100, 200 and 1000 times around the 200 loops of calculations with the following average run time results:

Vlookupsmatch and offsetmatch and cellArray match and cell
50 loops0.0050780.0054690.00726627.76258
100 loops0.0050.0050.00625too long
200 loops0.0048440.0050.006309too long
1000 loops0.0047770.0048120.006258too long

<tbody>
</tbody>

So looking at this the vlookup method seems to be the fastest unless I'm doing something wrong with the code sets (all contained below).

Am I doing something wrong because if vlookup is the best then the min run time for the actual code is 60 seconds which isn't good....

Code:
Sub Test_vlookup()'test place to see how vlookup will work
L = 1000
Dim wb As Workbook
Dim ws As Worksheet
'set up outputs
 Set wb = ActiveWorkbook
 Set ws = wb.Sheets("Test_scores")
ws.Range("a1").Value = "Vlookups"


For N = 1 To L


Dim Start As Date
Dim V_Row As String
Dim MS_Data As Range
Dim Bar_data As Range
Dim Vref As Integer
Dim test As String
Dim t As Single


t = Timer


'Worksheets("MS Project Bars Import").Activate
'Set MS_Data = Range("$AX:$BH")
Set MS_Data = Worksheets("MS Project Bars Import").Range("MS_Data")
'Worksheets("Bar Details").Activate
Set Bar_data = Worksheets("Bar Details").Range("Bar_data")


For Vref = 1 To 200


    If IsError(Application.VLookup(Vref, MS_Data, 1, False)) Or IsError(Application.VLookup(Vref, Bar_data, 1, False)) Then 'checks if the VRef is used in either the plan or the bar_details sheet to avoid issues with the vlookups
        ItemType = "BLANK_Main"
        'Debug.Print "Ref: " & Vref & " no data"
    Else
        Start = Application.WorksheetFunction.VLookup(Vref, MS_Data, 2, False)
        finish = Application.WorksheetFunction.VLookup(Vref, MS_Data, 3, False)
        BLStart = Application.WorksheetFunction.VLookup(Vref, MS_Data, 4, False)
        BLFinish = Application.WorksheetFunction.VLookup(Vref, MS_Data, 5, False)
        Complete = Application.WorksheetFunction.VLookup(Vref, MS_Data, 6, False)
        Slack = Application.WorksheetFunction.VLookup(Vref, MS_Data, 7, False)
        RAG = Application.WorksheetFunction.VLookup(Vref, MS_Data, 8, False)
        MS = Application.WorksheetFunction.VLookup(Vref, MS_Data, 9, False)
        Critical = Application.WorksheetFunction.VLookup(Vref, MS_Data, 11, False)
        
        'Debug.Print "MS_Data: "
        'Debug.Print "Vref: " & Vref & " Start: " & Start & " " & finish & " " & BLStart & " " & BLFinish & " " & Complete & " " & Slack & " " & RAG & " " & MS & " " & Critical
        
        'test = Vref & "-"
        V_Row = Application.WorksheetFunction.VLookup(Vref, Bar_data, 6, False)
        Hidden_name = Application.WorksheetFunction.VLookup(Vref, Bar_data, 2, False)
        Display_name = Application.WorksheetFunction.VLookup(Vref, Bar_data, 3, False)
        V_Row_number = Application.WorksheetFunction.VLookup(Vref, Bar_data, 4, False)
        Bar_colour = Application.WorksheetFunction.VLookup(Vref, Bar_data, 5, False)
        AB = Application.WorksheetFunction.VLookup(Vref, Bar_data, 7, False)
        Height_mod = Application.WorksheetFunction.VLookup(Vref, Bar_data, 8, False)
   '     V_Row = V_Row * 1
        
        'Debug.Print "Bar_data: "
        'Debug.Print "ref: " & Vref & "row = " & V_Row & " " & Hidden_anem & " " & Display_name & " " & V_Row_number & " " & Bar_colour & " " & AB & " " & Height_mod
    End If
    'Debug.Print "Vref: " & Vref & " Start: " & Start & " - " & V_Row
Next Vref
'MsgBox Timer - t
    s = Timer - t
    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Test_scores")


    ws.Range("a" & N + 2).Value = s
    tt = tt + s
    
Next N
ws.Range("a2").Value = tt / L
'MsgBox tt / L
End Sub
Sub Test_match_and_offset()
'test place to see how Match and Offset will work


L = 1000
Dim wb As Workbook
Dim ws As Worksheet
'set up outputs
 Set wb = ActiveWorkbook
 Set ws = wb.Sheets("Test_scores")
ws.Range("b1").Value = "match and offset"


For N = 1 To L


Dim Start As Date
Dim V_Row As String
Dim MS_Data As Range
Dim Bar_data As Range
Dim Vref As Integer
Dim t As Single
t = Timer
Dim MS_Data_Line_line As String
Dim MS_Data_index As Range
Dim MS_Data_Origin As Range
Dim Bar_data_index As Range
Dim Bar_data_origin As Range
Dim Bar_Data_Line As String


'Worksheets("MS Project Bars Import").Activate ' this doesn't appear to be working
'Set MS_Data = Range("$AX:$BH")
Set MS_Data = Worksheets("MS Project Bars Import").Range("MS_Data") 'why is this not picking up the range???
'Set MS_Data = ActiveWorkbook.Names("MS_Data").RefersToRange
Set MS_Data_index = Range("MS_Data").Columns(1)
Set MS_Data_Origin = Range(Range("MS_Data").Cells(1, 1).Address(0, 0))


'Worksheets("Bar Details").Activate
Set Bar_data = Worksheets("Bar Details").Range("Bar_data")
Set Bar_data_index = Range("Bar_data").Columns(1)
Set Bar_data_origin = Range(Range("Bar_data").Cells(1, 1).Address(0, 0))


'Debug.Print "MS_Data_Origin: " & MS_Data_Origin.Value
'Debug.Print "Bar_Data_Origin: " & Bar_data_origin.Value


For Vref = 1 To 200
    If IsError(Application.Match(Vref, MS_Data_index, 0)) Or IsError(Application.Match(Vref, Bar_data_index, 0)) Then 'checks if the VRef is used in either the plan or the bar_details sheet to avoid issues with the vlookups
        ItemType = "BLANK_Main"
        'Debug.Print "Ref: " & Vref & " no data"
    Else
        MS_Data_Line = Application.WorksheetFunction.Match(Vref, MS_Data_index, 0) - 1
        Start = MS_Data_Origin.Offset(MS_Data_Line, 1).Value
        finish = MS_Data_Origin.Offset(MS_Data_Line, 2).Value
        BLStart = MS_Data_Origin.Offset(MS_Data_Line, 3).Value
        BLFinish = MS_Data_Origin.Offset(MS_Data_Line, 4).Value
        Complete = MS_Data_Origin.Offset(MS_Data_Line, 5).Value
        Slack = MS_Data_Origin.Offset(MS_Data_Line, 6).Value
        RAG = MS_Data_Origin.Offset(MS_Data_Line, 7).Value
        MS = MS_Data_Origin.Offset(MS_Data_Line, 8).Value
        Critical = MS_Data_Origin.Offset(MS_Data_Line, 10).Value
        'Debug.Print "MS_Data: "
        'Debug.Print "Ref: " & Vref & " line: " & MS_Data_Line & "start: " & Start & " " & finish & " " & BLStart & " " & BLFinish & " " & Complete & " " & Slack & " " & RAG & " " & MS & " " & Critical
        
        Bar_Data_Line = Application.Match(Vref, Bar_data_index, 0) - 1
        V_Row = Bar_data_origin.Offset(Bar_Data_Line, 5).Value
        Hidden_name = Bar_data_origin.Offset(Bar_Data_Line, 1).Value
        Display_name = Bar_data_origin.Offset(Bar_Data_Line, 2).Value
        V_Row_number = Bar_data_origin.Offset(Bar_Data_Line, 3).Value
        Bar_colour = Bar_data_origin.Offset(Bar_Data_Line, 4).Value
        AB = Bar_data_origin.Offset(Bar_Data_Line, 6).Value
        Height_mod = Bar_data_origin.Offset(Bar_Data_Line, 7).Value
        'Debug.Print "Bar_data: "
        'Debug.Print "Ref: " & Vref & " line: " & Bar_Data_Line & "Y axis " & V_Row & " " & Hidden_anem & " " & Display_name & " " & V_Row_number & " " & Bar_colour & " " & AB & " " & Height_mod
    End If
    'Debug.Print "Ref: " & Vref & ":" & "line: " & line & ": " & Start & " - " & V_Row
Next Vref


'MsgBox Timer - t
    s = Timer - t
    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Test_scores")


    ws.Range("b" & N + 2).Value = s
    tt = tt + s
    
Next N
ws.Range("b2").Value = tt / L
'MsgBox tt / L
End Sub
Sub Test_match_and_cell()
'test place to see how Match and Cell will work


L = 1000
Dim wb As Workbook
Dim ws As Worksheet
'set up outputs
 Set wb = ActiveWorkbook
 Set ws = wb.Sheets("Test_scores")
ws.Range("c1").Value = "match and cell"


For N = 1 To L


Dim Start As Date
Dim V_Row As String
Dim MS_Data As Range
Dim Bar_data As Range
Dim Vref As Integer
Dim t As Single
t = Timer
Dim MS_Data_Line_line As String
Dim MS_Data_index As Range
Dim MS_Data_Origin As Range
Dim Bar_data_index As Range
Dim Bar_data_origin As Range
Dim Bar_Data_Line As String


'Worksheets("MS Project Bars Import").Activate ' this doesn't appear to be working
'Set MS_Data = Range("$AX:$BH")
Set MS_Data = Worksheets("MS Project Bars Import").Range("MS_Data") 'why is this not picking up the range???
'Set MS_Data = ActiveWorkbook.Names("MS_Data").RefersToRange
'Set MS_Data_index = Range("MS_Data").Columns(1)
'Set MS_Data_Origin = Range(Range("MS_Data").Cells(1, 1).Address(0, 0))


'Worksheets("Bar Details").Activate
Set Bar_data = Worksheets("Bar Details").Range("Bar_data")
'Set Bar_data_index = Range("Bar_data").Columns(1)
'Set Bar_data_origin = Range(Range("Bar_data").Cells(1, 1).Address(0, 0))


'Debug.Print "MS_Data_Origin: " & MS_Data_Origin.Value
'Debug.Print "Bar_Data_Origin: " & Bar_data_origin.Value


For Vref = 1 To 200
    If IsError(Application.Match(Vref, MS_Data.Columns(1), 0)) Or IsError(Application.Match(Vref, Bar_data.Columns(1), 0)) Then 'checks if the VRef is used in either the plan or the bar_details sheet to avoid issues with the vlookups
        ItemType = "BLANK_Main"
        'Debug.Print "Ref: " & Vref & " no data"
    Else
        MS_Data_Line = Application.Match(Vref, MS_Data.Columns(1), 0) ' finds the row for VRef
        Start = MS_Data.Cells(MS_Data_Line, 2) 'MS_Data_Origin.Offset(MS_Data_Line, 1).Value
        finish = MS_Data.Cells(MS_Data_Line, 3) 'MS_Data_Origin.Offset(MS_Data_Line, 2).Value
        BLStart = MS_Data.Cells(MS_Data_Line, 4) 'MS_Data_Origin.Offset(MS_Data_Line, 3).Value
        BLFinish = MS_Data.Cells(MS_Data_Line, 5) 'MS_Data_Origin.Offset(MS_Data_Line, 4).Value
        Complete = MS_Data.Cells(MS_Data_Line, 6) 'MS_Data_Origin.Offset(MS_Data_Line, 5).Value
        Slack = MS_Data.Cells(MS_Data_Line, 7) 'MS_Data_Origin.Offset(MS_Data_Line, 6).Value
        RAG = MS_Data.Cells(MS_Data_Line, 8) 'MS_Data_Origin.Offset(MS_Data_Line, 7).Value
        MS = MS_Data.Cells(MS_Data_Line, 9) 'MS_Data_Origin.Offset(MS_Data_Line, 8).Value
        Critical = MS_Data.Cells(MS_Data_Line, 11) 'MS_Data_Origin.Offset(MS_Data_Line, 10).Value
        'Debug.Print "MS_Data: "
        'Debug.Print "Ref: " & Vref & " line: " & MS_Data_Line & "start: " & Start & " " & finish & " " & BLStart & " " & BLFinish & " " & Complete & " " & Slack & " " & RAG & " " & MS & " " & Critical
        
        Bar_Data_Line = Application.Match(Vref, Bar_data.Columns(1), 0)
        V_Row = Bar_data.Cells(Bar_Data_Line, 6) 'Bar_data_origin.Offset(Bar_Data_Line, 5).Value
        Hidden_name = Bar_data.Cells(Bar_Data_Line, 2) 'Bar_data_origin.Offset(Bar_Data_Line, 1).Value
        Display_name = Bar_data.Cells(Bar_Data_Line, 3) 'Bar_data_origin.Offset(Bar_Data_Line, 2).Value
        V_Row_number = Bar_data.Cells(Bar_Data_Line, 4) 'Bar_data_origin.Offset(Bar_Data_Line, 3).Value
        Bar_colour = Bar_data.Cells(Bar_Data_Line, 5) 'Bar_data_origin.Offset(Bar_Data_Line, 4).Value
        AB = Bar_data.Cells(Bar_Data_Line, 7) 'Bar_data_origin.Offset(Bar_Data_Line, 6).Value
        Height_mod = Bar_data.Cells(Bar_Data_Line, 8) 'Bar_data_origin.Offset(Bar_Data_Line, 7).Value
        'Debug.Print "Bar_data: "
        'Debug.Print "Ref: " & Vref & " line: " & Bar_Data_Line & " Y axis " & V_Row & " " & Hidden_anem & " " & Display_name & " " & V_Row_number & " " & Bar_colour & " " & AB & " " & Height_mod
    End If
    'Debug.Print "Ref: " & Vref & ":" & "line: " & line & ": " & Start & " - " & V_Row
Next Vref
'MsgBox Timer - t
    s = Timer - t
    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Test_scores")


    ws.Range("c" & N + 2).Value = s
    tt = tt + s
    
Next N
ws.Range("c2").Value = tt / L
'MsgBox tt / L
End Sub
Sub Test_Array_match_and_cell()
'test place to see how Match and array will work


L = 50
Dim wb As Workbook
Dim ws As Worksheet
'set up outputs
 Set wb = ActiveWorkbook
 Set ws = wb.Sheets("Test_scores")
ws.Range("d1").Value = "Array match and cell"


For N = 1 To L


Dim Start As Date
Dim V_Row As String
Dim MS_Data As Range
Dim Bar_data As Range
Dim Vref As Integer
Dim t As Single
t = Timer
Dim MS_Data_Line As Long
Dim MS_Data_index As Range
Dim MS_Data_Origin As Range
Dim Bar_data_index As Range
Dim Bar_data_origin As Range
Dim Bar_Data_Line As Long
Dim MS_Data_Array As Variant




'Worksheets("MS Project Bars Import").Activate ' this doesn't appear to be working
'Set MS_Data = Range("$AX:$BH")
Set MS_Data = Worksheets("MS Project Bars Import").Range("MS_Data") 'why is this not picking up the range???
MS_Data_Array = MS_Data.Value
'Set MS_Data = ActiveWorkbook.Names("MS_Data").RefersToRange
'Set MS_Data_index = Range("MS_Data").Columns(1)
'Set MS_Data_Origin = Range(Range("MS_Data").Cells(1, 1).Address(0, 0))


'Worksheets("Bar Details").Activate
Set Bar_data = Worksheets("Bar Details").Range("Bar_data")
'Set Bar_data_index = Range("Bar_data").Columns(1)
'Set Bar_data_origin = Range(Range("Bar_data").Cells(1, 1).Address(0, 0))


'Debug.Print "MS_Data_Origin: " & MS_Data_Origin.Value
'Debug.Print "Bar_Data_Origin: " & Bar_data_origin.Value


For Vref = 1 To 200
    If IsError(Application.Match(Vref, MS_Data.Columns(1), 0)) Or IsError(Application.Match(Vref, Bar_data.Columns(1), 0)) Then 'checks if the VRef is used in either the plan or the bar_details sheet to avoid issues with the vlookups
        ItemType = "BLANK_Main"
        'Debug.Print "Ref: " & Vref & " no data"
    Else
        MS_Data_Line = Application.Match(Vref, Application.Index(MS_Data_Array, , 1), 0) ' finds the row for VRef
        Start = MS_Data_Array(MS_Data_Line, 2) 'MS_Data_Origin.Offset(MS_Data_Line, 1).Value
        finish = MS_Data_Array(MS_Data_Line, 3) 'MS_Data_Origin.Offset(MS_Data_Line, 2).Value
        BLStart = MS_Data_Array(MS_Data_Line, 4) 'MS_Data_Origin.Offset(MS_Data_Line, 3).Value
        BLFinish = MS_Data_Array(MS_Data_Line, 5) 'MS_Data_Origin.Offset(MS_Data_Line, 4).Value
        Complete = MS_Data_Array(MS_Data_Line, 6) 'MS_Data_Origin.Offset(MS_Data_Line, 5).Value
        Slack = MS_Data_Array(MS_Data_Line, 7) 'MS_Data_Origin.Offset(MS_Data_Line, 6).Value
        RAG = MS_Data_Array(MS_Data_Line, 8) 'MS_Data_Origin.Offset(MS_Data_Line, 7).Value
        MS = MS_Data_Array(MS_Data_Line, 9) 'MS_Data_Origin.Offset(MS_Data_Line, 8).Value
        Critical = MS_Data_Array(MS_Data_Line, 11) 'MS_Data_Origin.Offset(MS_Data_Line, 10).Value
        'Debug.Print "MS_Data: "
        'Debug.Print "Ref: " & Vref & " line: " & MS_Data_Line & "start: " & Start & " " & finish & " " & BLStart & " " & BLFinish & " " & Complete & " " & Slack & " " & RAG & " " & MS & " " & Critical
        
        Bar_Data_Line = Application.Match(Vref, Bar_data.Columns(1), 0)
        V_Row = Bar_data.Cells(Bar_Data_Line, 6) 'Bar_data_origin.Offset(Bar_Data_Line, 5).Value
        Hidden_name = Bar_data.Cells(Bar_Data_Line, 2) 'Bar_data_origin.Offset(Bar_Data_Line, 1).Value
        Display_name = Bar_data.Cells(Bar_Data_Line, 3) 'Bar_data_origin.Offset(Bar_Data_Line, 2).Value
        V_Row_number = Bar_data.Cells(Bar_Data_Line, 4) 'Bar_data_origin.Offset(Bar_Data_Line, 3).Value
        Bar_colour = Bar_data.Cells(Bar_Data_Line, 5) 'Bar_data_origin.Offset(Bar_Data_Line, 4).Value
        AB = Bar_data.Cells(Bar_Data_Line, 7) 'Bar_data_origin.Offset(Bar_Data_Line, 6).Value
        Height_mod = Bar_data.Cells(Bar_Data_Line, 8) 'Bar_data_origin.Offset(Bar_Data_Line, 7).Value
        'Debug.Print "Bar_data: "
        'Debug.Print "Ref: " & Vref & " line: " & Bar_Data_Line & " Y axis " & V_Row & " " & Hidden_anem & " " & Display_name & " " & V_Row_number & " " & Bar_colour & " " & AB & " " & Height_mod
    End If
    'Debug.Print "Ref: " & Vref & ":" & "line: " & line & ": " & Start & " - " & V_Row
Next Vref


'MsgBox Timer - t
    s = Timer - t
    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Test_scores")


    ws.Range("d" & N + 2).Value = s
    tt = tt + s
    
Next N
ws.Range("d2").Value = tt / L
'MsgBox tt / L
End Sub
 
Last edited:
Upvote 0

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
I'm interested in all ideas, I must have missed that, to save me counting to 30 on this rubbish internet connection can you remind me of the idea? :)

"Is your table sorted in ascending order? If not, are you allowed to do so and keep it in sorted order?" If so, what is the current range of the table and where do you have the values to look up in that table?
 
Upvote 0
Great thanks for that quote. Yes the tables are already sorted by vref. The original solution is using the vlookup function, see the first code block, and at the moment it's the fastest of the test code blocks. Unfortunately the full code set takes 60 seconds to run which promoted the original request for help as this is far too long. :(

In answer to your other questions the source data in the test data are the ranges ms_data and bar_data and I'm looking up vref.
 
Last edited:
Upvote 0
Great thanks for that quote. Yes the tables are already sorted by vref. The original solution is using the vlookup function, see the first code block, and at the moment it's the fastest of the test code blocks. Unfortunately the full code set takes 60 seconds to run which promoted the original request for help as this is far too long. :(

Quote? These are questions you are asked to answer... unless not interested in a formula solution.
 
Upvote 0
Quote? These are questions you are asked to answer... unless not interested in a formula solution.
You're right I'm not interested in the worksheet formula solution - I've solved that long ago but I now need to replace the worksheet with code as I can't protect the worksheet adequately which is annoying.
 
Upvote 0
You're right I'm not interested in the worksheet formula solution - I've solved that long ago but I now need to replace the worksheet with code as I can't protect the worksheet adequately which is annoying.

So what is that solution of long ago if I may ask?
 
Upvote 0
It's a massive set of vlookup calculations :) the worksheet solution is much more elegant as only the lines that change are recalculated whereas the code has to do everything every time :(
 
Upvote 0
It's a massive set of vlookup calculations :) the worksheet solution is much more elegant as only the lines that change are recalculated whereas the code has to do everything every time :(

I'm going to think that you did not pick out the most efficient approach. Care to share just one VLOOKUP formula you tried out?
 
Upvote 0

Forum statistics

Threads
1,215,576
Messages
6,125,633
Members
449,242
Latest member
Mari_mariou

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top