Vlookup Macro fine-tuning

aaleem

Board Regular
Joined
Sep 26, 2014
Messages
56
Office Version
  1. 2016
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.

VBA Code:
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
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
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
VBA 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.

VBA Code:
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
 
Upvote 0
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
VBA 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:

VBA Code:
If authorWs.FilterMode Then
    authorWs.ShowAllData
End If

If detailsWs.FilterMode Then
    detailsWs.ShowAllData
End If
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top