Vlookup Macro fine-tuning

[aaleem]

Hi,

i have the below macro in one of the file which has more than 100,000+ records.

this macro is taking approx. 10 minutes to run.

is there any way we can speed up the process?
Any suggestion will be much apprciated.

Sub VlookupLocation()

Dim authorWs As Worksheet, detailsWs As Worksheet
Dim authorsLastRow As Long, detailsLastRow As Long, x As Long
Dim dataRng As Range

Set authorWs = ThisWorkbook.Worksheets("Unmatched GRN Report")
Set detailsWs = ThisWorkbook.Worksheets("Loc_Status")

authorsLastRow = authorWs.Range("A" & Rows.Count).End(xlUp).Row
detailsLastRow = detailsWs.Range("A" & Rows.Count).End(xlUp).Row

Set dataRng = detailsWs.Range("A2:L" & detailsLastRow)



For x = 2 To authorsLastRow
    On Error Resume Next
    
    If authorWs.Range("AD" & x).Value = "" Then
    
    authorWs.Range("AD" & x).Value = Application.WorksheetFunction.VLookup( _
    authorWs.Range("G" & x).Value, dataRng, 2, False)
    
    authorWs.Range("AG" & x).Value = Application.WorksheetFunction.VLookup( _
    authorWs.Range("G" & x).Value, dataRng, 5, False)
    
    authorWs.Range("AI" & x).Value = Application.WorksheetFunction.VLookup( _
    authorWs.Range("G" & x).Value, dataRng, 7, False)
    
    authorWs.Range("AL" & x).Value = Application.WorksheetFunction.VLookup( _
    authorWs.Range("G" & x).Value, dataRng, 10, False)
    
    
    authorWs.Range("AM" & x).Value = Application.WorksheetFunction.VLookup( _
    authorWs.Range("G" & x).Value, dataRng, 11, False)
    
    authorWs.Range("AN" & x).Value = Application.WorksheetFunction.VLookup( _
    authorWs.Range("G" & x).Value, dataRng, 12, False)
    
    Else
    End If
    
Next x

End Sub

 

[aaleem]

after

With authorWs.Cells(1, 1).CurrentRegion

 

[kevin9999]

Thank you very much kevin9999 for your time and thoughts.

Excellent piece of code. works faster. only two things.

i have tested this code as well,

if the authorWs already has the filter on the columns, we need to remove the filter or update the code

.AutoFilter

after


and in column 30 of authorWs doesn't have blanks then this will throughout the error.

kind regards
aleem

I've tested the code with the filter both on and off, and the code still seems to work either way. With regard to your second point, I've added a bit of code to accommodate the possibility of no blank records in column AD.

Option Explicit
Sub VlookUp_Speed_2()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    Dim authorWs As Worksheet, detailsWs As Worksheet
    Set authorWs = Worksheets("Unmatched GRN Report")
    Set detailsWs = Worksheets("Loc_Status")
    
    Dim lr1 As Long, lr2 As Long
    lr1 = authorWs.Cells(Rows.Count, 1).End(3).Row
    lr2 = detailsWs.Cells(Rows.Count, 1).End(3).Row
    
    detailsWs.Range("A2:L" & lr2).Name = "myRange"
    
    Dim rng1 As Range
    With authorWs.Cells(1, 1).CurrentRegion
        .AutoFilter 30, "="
        If authorWs.Range("A:A").SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
            MsgBox "No blank records found"
            .AutoFilter
            GoTo GetOut
        End If
        Set rng1 = authorWs.Range("AD2:AN" & lr1).SpecialCells(12)
        Set rng1 = Intersect(rng1, Union(Columns(30), Columns(33), Columns(35), Columns(38), Columns(39), Columns(40)))
        rng1.Value = "=vlookup($G2,myrange,Column()-28,false)"
        .AutoFilter
    End With
    
    With authorWs.Range("AD2:AN" & lr1)
        .Value = .Value
    End With
GetOut:
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

 

[Alex Blakenburg]

Thank you very much kevin9999 for your time and thoughts.

Excellent piece of code. works faster. only two things.

i have tested this code as well,

if the authorWs already has the filter on the columns, we need to remove the filter or update the code

.AutoFilter

after


and in column 30 of authorWs doesn't have blanks then this will throughout the error.

kind regards
aleem

Love the fact that you are testing the different options and giving great feedback.

In looking at @kevin9999s code and your feedback, all the methods will have an issue when a filter is applied in that the lines that calculate Last Row (lr1, lr2) will be out.
With a filter applied they don't give the correct last row.
Kevin's code has the additional issue that the filters are cumulative, so unless any filter already applied is only on Column 30, the Column 30 filter will filter the data further, so otherwise eligible rows will remain hidden.

Ideally before the calculating the Last Row we need to add something like this:

If authorWs.FilterMode Then
    authorWs.ShowAllData
End If

If detailsWs.FilterMode Then
    detailsWs.ShowAllData
End If

 

[aaleem]

I've tested the code with the filter both on and off, and the code still seems to work either way. With regard to your second point, I've added a bit of code to accommodate the possibility of no blank records in column AD.

Option Explicit
Sub VlookUp_Speed_2()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
   
    Dim authorWs As Worksheet, detailsWs As Worksheet
    Set authorWs = Worksheets("Unmatched GRN Report")
    Set detailsWs = Worksheets("Loc_Status")
   
    Dim lr1 As Long, lr2 As Long
    lr1 = authorWs.Cells(Rows.Count, 1).End(3).Row
    lr2 = detailsWs.Cells(Rows.Count, 1).End(3).Row
   
    detailsWs.Range("A2:L" & lr2).Name = "myRange"
   
    Dim rng1 As Range
    With authorWs.Cells(1, 1).CurrentRegion
        .AutoFilter 30, "="
        If authorWs.Range("A:A").SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
            MsgBox "No blank records found"
            .AutoFilter
            GoTo GetOut
        End If
        Set rng1 = authorWs.Range("AD2:AN" & lr1).SpecialCells(12)
        Set rng1 = Intersect(rng1, Union(Columns(30), Columns(33), Columns(35), Columns(38), Columns(39), Columns(40)))
        rng1.Value = "=vlookup($G2,myrange,Column()-28,false)"
        .AutoFilter
    End With
   
    With authorWs.Range("AD2:AN" & lr1)
        .Value = .Value
    End With
GetOut:
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

Thank you so much Kevin for your time and suggestion and updated code., I have tested and it is working perfectly.
kind regards
aleem

 

[kevin9999]

Glad we could help, and thanks for the feedback. Please note Alex's advice in post #23.