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

[miless2111s]

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

 

[Norie]

Miles

You would use Match to find the row and then you could use that to get values from multiple columns without having to use repeat Vlookups.

I'd post some code to demonstrate but I'm having serious WiFi problems at the moment.

 

[miless2111s]

Thanks Norie - isn't technology great; right up until the point where it lets you down!

 

[miless2111s]

I've had a go at replacing vlookup with Match / Offset by producing some small code sets and I'm finding that the vlookup is actually faster!! The code is below, have I done something wrong or is vlookup actually quicker. If so what other options do I have to make this thing run quickly?

Vlookup:

Sub Test_vlookup()
'test place to see how vlookup will work
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 = Range("MS_Data")
Worksheets("Bar Details").Activate
Set Bar_data = 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
End Sub

Match / Offset:

Sub Test_match_and_offset()
'test place to see how Match and Offset will work
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 = 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 = 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
End Sub

Many thanks

Miles

 

[Norie]

Miles

In the orignal code you you appeared to have a few Vlookups that were basically the same apart from the column data was being returned from changed.

It was those that I thought would benefit from being replaced with something using Match.

I'll take a look at the original code and post back.

PS I posted something yesterday but the forum has apparently been having problems and a whole bunch of posts were lost.

 

[Norie]

Miles

This is the section of code I thought might benefit from using Match.

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"
        Else
            If Application.VLookup(vref, MS_Data, 2, False) > SummaryEnd Or Application.VLookup(vref, MS_Data, 3, False) < SumamryStart Then    ' checks if the dates are within the summary ranges - if not they will be treated as BLANK
                ItemType = "BLANK_Main"
            Else
                Res = Application.Match(vref, MS_Data.Columns(1), 0)
                
                ItemType = ""    ' reset item type just in case

                Start = MS_Data.Cells(Res, 2) ' Application.VLookup(Vref, MS_Data, 2, False)
                If Start < SumamryStart Then Start = SumamryStart    'sets the start to the first date in the summary if it is before (makes plotting easier)

                finish = MS_Data.Cells(Res, 3) ' Application.VLookup(Vref, MS_Data, 3, False)
                If finish > SummaryEnd Then finish = SummaryEnd    'sets the finish to the last date in the summary if it is before (makes plotting easier)

                BLStart = MS_Data.Cells(Res, 4) ' Application.VLookup(Vref, MS_Data, 4, False)
                If BLStart < SumamryStart Then BLStart = SumamryStart    'sets the start to the first date in the summary if it is before (makes plotting easier)

                BLFinish = MS_Data.Cells(Res, 5) ' Application.VLookup(Vref, MS_Data, 5, False)
                If BLFinish > SummaryEnd Then BLFinish = SummaryEnd    'sets the finish to the last date in the summary if it is before (makes plotting easier)

                Complete = MS_Data.Cells(Res, 6) ' Application.VLookup(Vref, MS_Data, 6, False)

                Slack = MS_Data.Cells(Res, 7) ' Application.VLookup(Vref, MS_Data, 7, False)

                RAG = MS_Data.Cells(Res, 8) ' Application.VLookup(Vref, MS_Data, 8, False)
                
                If MS_Data.Cells(Res, 9) Then ' Application.VLookup(Vref, MS_Data, 9, False) = "y" Then
                    MS = "y"
                Else
                    MS = "n"
                End If
                
                Critical = MS_Data.Cells(Res, 11) 'Application.VLookup(Vref, MS_Data, 11, False)
                
                Res = Application.Match(vref, Bar_data.Columns(1), 0)
                
                ColourCode = Bar_data.Cells(Res, 5) ' Application.VLookup(vref, Bar_data, 5, False)

                VerticalMod = Bar_data.Cells(Res, 8) '  Application.VLookup(vref, Bar_data, 8, False)

                above_below = Bar_data.Cells(Res, 7) ' Application.VLookup(vref, Bar_data, 7, False)

                Row_Pos = Bar_data.Cells(Res, 4) ' Application.VLookup(vref, Bar_data, 4, False)

                'set ItemType
                If MS = "n" Then
                    ItemType = "Main"
                Else
                    If above_below = "" Then ItemType = "MS_on_line"
                    If above_below = "above" Then ItemType = "MS_above_line"
                    If above_below = "below" Then ItemType = "MS_below_line"
                End If
            End If
        End If

 

[miless2111s]

Hi Norie

yes - I did the same and lost it

You'll see from the above test code that I attempted to replicate the situation you noticed where I am pulling information from the same table - i.e. go to a given entry (Vref) and grab a load of information about it. I had expected the match / offset to do best in this situation however running the code produced the following average times:
Vlookup: 0.3691407
Match & Offset: 0.4179688

Throughout the rest of the code there are lookups which inspect a much longer set of tables 2 columns wide to find matches but I didn't think that the match/offset method would be efficient for them.

I did wonder if there was a way to read these tables into the code set (or even create them in the first place) and then read them within the code but I don't know!

 

[Norie]

You could read the ranges/tables into arrays which might speed things up but it might also make the code pretty complicated.

 

[miless2111s]

I hadn't realised that arrays could be multi dimensional - the examples I'd come across were things like (apples, pears, grapes, bananas, strawberries) and you select the 3rd one in the list. Can you point me at something that explains how to store a whole table in an array and then select values based on a value to 'lookup'?

What would the performance impact of doing this be?

Thanks

Miles

 

[miless2111s]

OK, was I using the wrong technique there then?

I see you've used MS_Data(res,2) - i.e. MS_data.cells((Application.Match(vref, MS_Data.Columns(1), 0),2) so I'll need to look up how this works because I don't recognise this and I assume I was using offset in the wrong way? Especially as I was having to mess around finding the index column and origin to offset from which must have taken up some of the calculation time

Can I attempt to follow what you've done to see if my understanding is right as there's no point just blindly copying....
1) Res is the number of rows down the column left most column in the range MS_data; found by MS_Data.Columns(1) - which I'd pulled out into an index column? When I did this I had to remove one row to get it to track to the right place but maybe that's a tweek
2) You get the data point in the table by using the range.cell command by counting down Res rows from the top of the range and then across by the required number of columns?

This last step is similar to my Start = MS_Data_Origin.Offset(MS_Data_Line, 1).Value but I assume faster? I'll have a go at modifying my test code to check if this is the case

Is my understanding right?

Thanks

Miles

 

[Norie]

Miles

You can store a whole range in a 2 dimensional range, for example.

Dim MS_Data As Range
Dim arrMS_Data As Variant

    Set MS_Data = Range("MS_Data")

    arrMS_Data = MS_Data.Value

You would still use Match on that array so there would be no gain there but when it comes to actually getting the values you want pulling them from the array should be quicker than from a range on a worksheet.

Let's say you did have the code above then the code we've both been working on might look something like this.

               Res = Application.Match(vref, Application.Index(arrMS_Data, 1), 0)
                
                ItemType = ""    ' reset item type just in case

                Start = arrMS_Data(Res, 2) ' Application.VLookup(Vref, MS_Data, 2, False)
                If Start < SumamryStart Then Start = SumamryStart    'sets the start to the first date in the summary if it is before (makes plotting easier)

                finish = arrMS_Data(Res, 3) ' Application.VLookup(Vref, MS_Data, 3, False)
                If finish > SummaryEnd Then finish = SummaryEnd    'sets the finish to the last date in the summary if it is before (makes plotting easier)

                BLStart = arrMS_Data(Res, 4) ' Application.VLookup(Vref, MS_Data, 4, False)
                If BLStart < SumamryStart Then BLStart = SumamryStart    'sets the start to the first date in the summary if it is before (makes plotting easier)

                BLFinish = arrMS_Data(Res, 5) ' Application.VLookup(Vref, MS_Data, 5, False)
                If BLFinish > SummaryEnd Then BLFinish = SummaryEnd    'sets the finish to the last date in the summary if it is before (makes plotting easier)

                Complete = arrMS_Data(Res, 6) ' Application.VLookup(Vref, MS_Data, 6, False)

                Slack = arrMS_Data(Res, 7) ' Application.VLookup(Vref, MS_Data, 7, False)

                RAG = arrMS_Data(Res, 8) ' Application.VLookup(Vref, MS_Data, 8, False)
                
                If arrMS_Data(Res, 9) Then ' Application.VLookup(Vref, MS_Data, 9, False) = "y" Then
                    MS = "y"
                Else
                    MS = "n"
                End If
                
                Critical = arrMS_Data(Res, 11) 'Application.VLookup(Vref, MS_Data, 11, False)

Of course that is totally untested for either errors or speed.