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.
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.