Is there a way to speed up this VBA macro running to perform a Vlookup on a large range 1000's of times?

Question

Sub Questionnaire_to_Ventilation()
'
' Questionnaire_to_Ventilation Macro
'
' Keyboard Shortcut: Ctrl+Shift+M
'
Application.ScreenUpdating = False
    Sheets("Ventilation").Select
    Dim LRow As Long
    LRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row
    For i = 0 To LRow
        For col = 8 To 13
            Sheets("Ventilation").Range("Y10").Offset(i, col - 8) = Application.IfError(Application.VLookup _
            (Sheets("Ventilation").Range("E10").Offset(i, 0), Sheets("Scheduling Questionnaire").Range("$B$11:$N$3337"), col, False), "")
        Next col
    Next i
Range("Y10").Select
Application.ScreenUpdating = True
End Sub

[Avoid using Select in your code](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) also, if the code works, this question may be better suited to https://codereview.stackexchange.com/ — cybernetic.nomad, Mar 09 '22 at 20:07
See here: https://stackoverflow.com/q/68130319/109122, my answer there shows how to implement a faster VLookup in VBA code. — RBarryYoung, Mar 09 '22 at 20:28
RBarryYoung I don't understand the implementation in your link. — Bubbybristor, Mar 09 '22 at 20:42
Seems to me that you are repeating a Vlookup only for the purpose of filling the different columns. so you repeat an expensive lookup 6 times. I do believe it helps when you add some data to your question so we understand what you try to achieve. And yes, it can be way faster... Sortedlist can be interesting or order and keep track of inex. It all depends on your data.. — Aldert, Mar 09 '22 at 20:59
The solution linked by @RBarryYoung involves a `Dictionary` which is an object that basically holds a bunch of data that you can access VERY quickly -- as long as each piece of data has a unique "key". In your case, the key would be the value you're using as the lookup value in `VLOOKUP`. You (probably) only need to build one `Dictionary`. The results are stored in a memory-based array, which would then be transferred to your worksheet. It will all be much faster. (Especially if you avoid `Select` as @cybernetic.nomad suggests. — PeterT, Mar 09 '22 at 21:10
https://lp3solutions-my.sharepoint.com/:x:/p/papo/Ec47zWt5x1hPvB5kWnFDEvYBLJybCiHmJ5P-q5kt4h_PPQ?e=La180X — Bubbybristor, Mar 09 '22 at 21:15
The "select" can't possibly be slowing down the code, right? It's outside of the loops. Also, I understand how the dictionary allows for quick access storage to speed up lookup instances, but based on his attached example, I don't know how to adapt his function to fit my VBA code. — Bubbybristor, Mar 09 '22 at 21:17
[Cross-posted on Code Review](https://codereview.stackexchange.com/q/274789/52915) — Mast, Mar 11 '22 at 16:05

VBasic2008 · Accepted Answer · 2022-03-30T01:47:33.853

INDEX/MATCH replaces VLOOKUP (VBA Formula)

Option Explicit

Sub Questionnaire_to_Ventilation()
'
' Questionnaire_to_Ventilation Macro
'
' Keyboard Shortcut: Ctrl+Shift+M
'
' Write the following formula...
' =IFERROR(INDEX('Scheduling Questionnaire'!I$11:I$3337,
'     MATCH($E10,'Scheduling Questionnaire'!$B$11:$B$3337,0)),"")
' ... to the range 'Y10:ADlr' and remove the formulas (leaving values).
'
    Const sName As String = "Scheduling Questionnaire"
    Const slCol As String = "B"
    Const svCol As String = "I"
    Const sRows As String = "11:3337"
    
    Const dName As String = "Ventilation"
    Const dlCol As String = "E"
    Const dvCol As String = "Y"
    Const dfRow As Long = 10
    
    Const cCount As Long = 6
    
    Dim slAddress As String, svAddress As String
    
    With ThisWorkbook.Worksheets(sName)
        Dim sNameRef As String: sNameRef = "'" & sName & "'!"
        slAddress = sNameRef & .Rows(sRows).Columns(slCol).Address
        svAddress = sNameRef & .Rows(sRows).Columns(svCol).Address(, 0)
    End With
    
    Application.ScreenUpdating = False

    With ThisWorkbook.Worksheets(dName)
        Dim dlRow As Long: dlRow = .Cells(.Rows.Count, dlCol).End(xlUp).Row
        Dim dlrg As Range
        Set dlrg = .Cells(dfRow, dlCol).Resize(dlRow - dfRow + 1)
        Dim dvrg As Range
        Set dvrg = dlrg.EntireRow.Columns(dvCol).Resize(, cCount)
        Dim dFormula As String
        dFormula = "=IFERROR(INDEX(" & svAddress & ",MATCH(" _
            & dlrg.Cells(1).Address(0) & "," & slAddress & ",0)),"""")"
        'Debug.Print dFormula
        dvrg.Formula = dFormula
        dvrg.Value = dvrg.Value
        Application.Goto Reference:=dvrg.Cells(1), Scroll:=True
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "Ventilation updated.", vbInformation

End Sub

Nicely done. - Btw Since it is now standard knowledge for ~most users to [avoid using `Select`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba?noredirect=1&lq=1), a brief explanation as to why this here is different would be helpful :-) @VBasic2008 — T.M., Mar 14 '22 at 07:49
@T.M.: I rather replaced the two `Select` lines with one `Application.Goto` line which automatically selects the correct worksheet and also lets us scroll. I only recently became aware of this feature. Thanks for your input. — VBasic2008, Mar 30 '22 at 01:56

Tim Williams · Answer 2 · 2022-03-09T22:09:01.350

This (using Match once per row and copying the data as a single block) will be faster:

Sub Questionnaire_to_Ventilation()
    Dim wsV As Worksheet, wsSQ As Worksheet, rngData As Range
    Dim i As Long, v, m
    
    Set wsV = ThisWorkbook.Worksheets("Ventilation")
    Set wsSQ = ThisWorkbook.Worksheets("Scheduling Questionnaire")
    Set rngData = wsSQ.Range("$B$11:$N$3337")
    
    Application.ScreenUpdating = False
    For i = 10 To wsV.Cells(wsV.Rows.Count, "E").End(xlUp).Row
        v = wsV.Cells(i, "E").Value
        If Len(v) > 0 Then   'the value to look up
            m = Application.Match(v, rngData.Columns(1), 0) 'match in data?
            If Not IsError(m) Then
                'got a match:copy over values from I:N on that row
                wsV.Cells(i, "Y").Resize(1, 6).Value = _
                         rngData.Rows(m).Cells(8).Resize(1, 6).Value
            End If
        End If
    Next i
End Sub

Is there a way to speed up this VBA macro running to perform a Vlookup on a large range 1000's of times?

2 Answers2

INDEX/MATCH replaces VLOOKUP (VBA Formula)

Linked