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

Can we see the code?

 

[miless2111s]

There's a heck of a lot of it so I guess I'll display some of it as the idea repeats a number of times

For Vref = 1 To 200
    OutputRow = OutputRow + 1
    ' note that the RAG, Progress and Baseline elements will need to also check to see if they should return blank
    ' BLANK will need to fill in Vref- Vref-p Vref-r and Vref-BL rows so not sure that this should be done in one block or in each section?
    
    'gather data for Vref 1 from MS_Data and Bar_data
    'NOTE: I've used a new range defined in this code only for this, if need to revert to Bar_details I will need Vref & "-"
    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
            ItemType = "" ' reset item type just in case
            Start = 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 = 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 = 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 = 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 = Application.VLookup(Vref, MS_Data, 6, False)
            Slack = Application.VLookup(Vref, MS_Data, 7, False)
            RAG = Application.VLookup(Vref, MS_Data, 8, False)
            If Application.VLookup(Vref, MS_Data, 9, False) = "y" Then MS = "y" Else MS = "n"
            Critical = Application.VLookup(Vref, MS_Data, 11, False)
            ColourCode = Application.VLookup(Vref, Bar_data, 5, False)
            VerticalMod = Application.VLookup(Vref, Bar_data, 8, False)
            above_below = Application.VLookup(Vref, Bar_data, 7, False)
            Row_Pos = 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
    
    If ItemType = "BLANK_Main" Then
        'call the BLANK sub routine and pass over ItemType to fill in the MAIN line with blank details
        'Call Blanks(ItemType, ref, width, height, angle, PinX, PinY, LocPinX, locpiny, lineType, lineWeight, lineColour, rounding, fillpatern, fillcolour, fillbackgound, name)
        ref = Vref & "-"
        width = "20mm"
        height = "5mm"
        angle = 0
        PinX = "-60mm"
        PinY = "-20mm"
        LocPinX = "Width*0"
        locpiny = "Height*0"
        lineType = 1
        lineWeight = "0.24 pt"
        lineColour = "RGB(0,0,0)"
        rounding = "0mm"
        fillpatern = 1
        fillcolour = "RGB(255,255,255)"
        FillBackground = "RGB(0,0,0,0)"
        name = "BLANK"
    Else
        'Do all the calculations required to output to the visio for main
        'width
        If MS = "y" Then
            width = MS_H & "mm"
        Else
            If Start = finish Then
                width = single_day & "mm"
            Else
                width = Application.VLookup(finish, Date_dim, 2) - Application.VLookup(Start, Date_dim, 2) & "mm"
            End If
        End If
        
        'height
        If MS = "y" Then
            height = MS_H & "mm"
        Else
            If VerticalMod = 0 Then
                height = Bar_h & "mm"
            Else
                height = Application.VLookup(VerticalMod, Row_dim, 2, True) + Bar_h - Application.VLookup(Vref, Bar_data, 6, False) & "mm"
            End If
        End If
            
        'angle
        If MS = "y" Then angle = MS_angle Else angle = 0
        PinX = Application.VLookup(finish, Date_dim, 2, True) & "mm"
        PinY = Application.VLookup(Vref, Bar_data, 6, False) & "mm"
        LocPinX = Application.VLookup(ItemType, LocPin, 5, False)
        locpiny = Application.VLookup(ItemType, LocPin, 6, False)
        lineType = Range("Bar_line_type")
        rounding = Range("main_bar_rounding")
        ref = Vref & "-"
        
        'save some settings for use in the baseline section:
        MainBarStartX = PinX
        MainBarEndX = PinX + Left(width, Len(width) - 2)
        
        'line weight
        If Critical = "y" Then lineWeight = Range("Line_Weight_Critical") Else lineWeight = Range("Line_Weight_normal")
        
        'fill colour
        If MS = "y" Then
            If MS_fill_switch = "Custom Colour" Then If Application.VLookup(Vref, Bar_data, 5, False) = "" Then ColourCode = "white" Else ColourCode = Application.VLookup(Vref, Bar_data, 5, False)
            If MS_fill_switch = "RAG" Then If Application.VLookup(Vref, MS_Data, 8, False) = "Unknown" Then ColourCode = "white" Else ColourCode = Application.VLookup(Vref, MS_Data, 8, False)
            If MS_fill_switch = "white" Then ColourCode = "white"
        End If
        If ColourCode = "" Then ColourCode = "white"
        fillcolour = Application.VLookup(ColourCode, CustColours, 5, False)
        MainColourCode = ColourCode
        
        'fill background
        FillBackground = Application.VLookup(ColourCode, CustColours, 11, False)
        
        'fill patern
        fillpatern = Application.VLookup(ColourCode, CustColours, 12, False) 'looks at colour code which has already been set
        'need to look carefully at what happens in the absence of a colour code - set to black and white for line and fill
        'what happens with the background?  The aim should be that it is the true inverse - which should work as the inverses are found at the top
        'of custom colours but needs to be tested.
        
        'line colour
        If MS = "y" Then
            If MS_line_switch = "Custom Colour" Then If Application.VLookup(Vref, Bar_data, 5, False) = "" Then ColourCode = "white" Else ColourCode = Application.VLookup(Vref, Bar_data, 5, False)
            If MS_line_switch = "RAG" Then If Application.VLookup(Vref, MS_Data, 8, False) = "Unknown" Then ColourCode = "white" Else ColourCode = Application.VLookup(Vref, MS_Data, 8, False)
            If MS_line_switch = "black" Then ColourCode = "black"
        End If
        If ColourCode = "white" Then ColourCode = "black" 'as in fill colour earlier if the colourcode is blank it is turned white for a white fill which needs a black line
        If Critical = "y" Then lineColour = Range("CP_line_colour") Else lineColour = Application.VLookup(ColourCode, CustColours, 5, False)
                
        'name
        If DebugRef = "y" Then
            name = Vref
        Else
            If MS = "y" And Show_MS_Dates = "y" Then
                name = Day(finish)
            Else
                name = Application.VLookup(Vref, Bar_data, 3, False)
            End If
        End If
                
        
        
    End If 'end of Main Bar calculations (both blank and data driven)
    'output main bar details
    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("MacroTest")
    ws.Range("a" & OutputRow).Value = ref
    ws.Range("b" & OutputRow).Value = width
    ws.Range("c" & OutputRow).Value = height
    ws.Range("d" & OutputRow).Value = angle
    ws.Range("g" & OutputRow).Value = PinX
    ws.Range("h" & OutputRow).Value = PinY
    ws.Range("i" & OutputRow).Value = LocPinX
    ws.Range("j" & OutputRow).Value = locpiny
    ws.Range("l" & OutputRow).Value = lineType
    ws.Range("m" & OutputRow).Value = lineWeight
    ws.Range("n" & OutputRow).Value = lineColour
    ws.Range("t" & OutputRow).Value = rounding
    ws.Range("u" & OutputRow).Value = fillpatern
    ws.Range("v" & OutputRow).Value = fillcolour
    ws.Range("w" & OutputRow).Value = FillBackground
    ws.Range("ae" & OutputRow).Value = name
    'output testing
 
OutputRow = OutputRow + 1
Next Vref

I've bodged together some code that outputs the same amount of data into a sheet and it ran in seconds so I assume it is the vlookups reaching into the workbook that takes the time but I am very much a beginner at this so I'd happily take any advise / help with this issue

 

[miless2111s]

anyone know why I can't edit my own post above?

I managed to edit it earlier and now I can edit this post but the one from earlier today is not longer showing an edit button!

Miles

 

[SpillerBD]

Editing is only allowed for a certain amount of time. This helps avoid confusion if a response is provided on the original post that could look inappropriate or foolish after an edit.

 

[miless2111s]

ah, makes sense. Shame thought but I understand

 

[SpillerBD]

VLOOKUPS are relatively slow. (At least your target arrays aren't 200k rows! I know how that is with IINDEX(MATCH()) )
You can always (if you haven't already done so) use

Application.ScreenUpdating = False
....
Application.ScreenUpdating = True

around your code to pick up some speed.

 

[miless2111s]

SpillerBD, I have that update trick in play already it's just not in the code segment supplied Any other tricks? Or is there a technique that replicates the Vlookup functionality without the speed drop?

 

[Norie]

As far as I can see some of your Vlookups seem to be almost identical, the only difference being the 3rd argument ie the column to return data from.

If that's the case you might be able to speed things up by using Match.

I'll need to have a closer look at the code later to see if that's feasible.

 

[miless2111s]

how would that work? As I understand it Match looks down one column to return a location within that column - would I then be using something like offset to find the value that I want on that row? Would that be faster than vlookup? Or is it that it wouldn't necessarily be faster for one item but when I'm picking up a bunch of values from the same row (especially true of the ones looking into the MS_Data table the cumulative impact would be significant?

Sorry for ay questions which sound dumb but as I say I'm a beginner here

Miles