Need to make excel vba vlookup more efficient

I'm redesigning some finance reports for my organization to move away from a 3rd party software and looking to use VBA to assist in the automation. Haven't written VBA since college, so a little rusty.

I've gotten the code to work, however it's very inefficient and is running at about 1000k records every 30 seconds, which is not feasible with a few hundred thousand records. I've tried several different options that you all have posted in different threads, but must be missing something.

Can you please take a look?

Most threads I've looked at have referenced either a direct input via single cell or same sheet to perform the lookup. This is a single column on Sheet A (ATB-Allowance Reserving-Calc) and then find lookups in table on Sheet B (Plan Global Lookups).

I do want it to skip over errors, and return nothing.

I've tried the fill down method and copy and paste, neither of which I can get to work with a formula. They just seem to want to fill with the value from the original formula.

I'm thinking it's not working due to jumping back and forth between sheets, which I've encountered issues with in different calculations.

I'm not one to just try one or two times, so this is definitely me at the end of my rope.

Dim GlobalExpPct As Variant

Range("AI2").Select  'Gets historical rates from Plan Global Lookups tab
Do
On Error Resume Next
GlobalExpPct = Application.WorksheetFunction.VLookup(ActiveCell.Offset(0, -24), Sheets("Plan Global Lookups").Range("A:B"), 2, False)
ActiveCell.value = GlobalExpPct
GlobalExpPct = vbNullString
ActiveCell.Offset(1, 0).Select

Loop While ActiveCell.Row < 1000 'have this in place to keep it from looping through all the records

I suspect the slow processing is due to selecting of the next cell each time, and then essentially calling the worksheet values and formula again. I'm typically seeing that the formula is returning either null value or getting the same value from the previous formula in the fill down.

Thanks for the help in advance. This is a great resource as I've been able to solve 99% of my issues so far on this site.

1 answer

  • answered 2019-06-25 01:29 Ahmed AU

    May try this and see if performance improves

    Sub testModified()
    Dim GlobalExpPct As Variant, Rng As Range, Rw As Long
    Dim ValtoLook, Ws As Worksheet, ActWs As Worksheet, tm As Double
    tm = Timer
    Set ActWs = ThisWorkbook.ActiveSheet
    Set Ws = ThisWorkbook.Sheets("Plan Global Lookups")
    'Set Rng = Ws.Range("A:B")
    'this would be more efficent
    Set Rng = Ws.Range("A1:B" & Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row)
    
        For Rw = 2 To 1000
        ValtoLook = ActWs.Range("AI" & Rw).Offset(0, -24).Value
        On Error Resume Next
        GlobalExpPct = Application.WorksheetFunction.VLookup(ValtoLook, Rng, 2, False)
        On Error GoTo 0
        Range("AI" & Rw).Value = GlobalExpPct
        GlobalExpPct = vbNullString
        Next Rw
    Debug.Print " Time in second " & Timer - tm; ""
    End Sub
    

    if i have not correctly guessed the columns and ranges you are working with, may kindly modify them to your requirement.

    It could be made efficient if you confirm there is all the values of Column K and AI are values and they are not inter dependent with some formulas etc. the above code may prove sufficient for 1000 rows. But for heavy files with 10-1000 K rows, the code required to be more efficient. in that case Excel cell operations are to be minimized by using array. Adding above code modified with Array

    Sub testModifiedArray()
    Dim GlobalExpPct As Variant, Rng As Range, Rw As Long
    Dim ValtoLook, Ws As Worksheet, ActWs As Worksheet
    Dim Rslt() As Variant, Src As Variant, tm As Double
    tm = Timer
    Set ActWs = ThisWorkbook.ActiveSheet
    Set Ws = ThisWorkbook.Sheets("Plan Global Lookups")
    'Set Rng = Ws.Range("A:B")
    'next line would be more efficent, You may define range directly if you know the end row
    Set Rng = Ws.Range("A1:B" & Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row)
    Src = ActWs.Range("K2:K1000").Value
        For Rw = 2 To 1000
        ValtoLook = Src(Rw - 1, 1)
        On Error Resume Next
        GlobalExpPct = Application.WorksheetFunction.VLookup(ValtoLook, Rng, 2, False)
        On Error GoTo 0
        ReDim Preserve Rslt(1 To Rw - 1)
        Rslt(Rw - 1) = IIf(IsNull(GlobalExpPct), "", GlobalExpPct)
        'Debug.Print Rslt(Rw - 1)
        GlobalExpPct = vbNullString
        Next Rw
    ActWs.Range("AI2").Resize(UBound(Rslt, 1), 1).Value = Application.Transpose(Rslt)
    
    Debug.Print " Time in second " & Timer - tm; ""
    End Sub
    

    Both the code tested with my Guess of Column and ranges. As I personally don't prefer to keep calculations, event processing and screen updating off (in normal cases) i haven't added that standard lines. However you may use these standard techniques, depending on the working file condition.