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

 

[bebo021999]

May be:

Option Explicit
Sub VlookupLocation()
Dim authorWs As Worksheet, detailsWs As Worksheet
Dim authorsLastRow As Long, detailsLastRow As Long, x As Long, col
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)
authorWs.Cells.AutoFilter field:=30, Criteria1:="" ' Create an autofilter for column AD =""
    On Error Resume Next
    For Each col In Array(2, 5, 7, 10, 11, 12) ' loop for each column_index of VLOOKUP formula
        With authorWs.Range(Cells(2, 28 + col), Cells(authorsLastRow, 28 + col))
            .Formula = "=VLOOKUP(G2,Loc_Status!$A$2:$L$" & detailsLastRow & "," & col & ",0)"
            ' upper paste the formula. If you want value only, just add 1 more line as below:
            '.Value = .Value
        End With
    Next
authorWs.AutoFilterMode = False ' remove Autofilter
End Sub

 

[aaleem]

Dear bebo021999,

thank you so much for your help.

i tried running the above code im getting Run-time error '1004. Auto filter method of Range class failed on the below line of code

authorWs.Cells.AutoFilter field:=30, Criteria1:="" ' Create an autofilter for column AD =""

the Sheet "Unmatched GRN Report" is having a Pivot Table by the name "Unmatched_GRN", is this error due to the Pivot table?

Also, I comment on this line of code and run the VBA, the Vlookup formula is getting pasted, is it possible instead of the Vlookup formula, that the value from the Loc_Status sheet should update.

Thank you again for your suggestions.
Aleem

 

[bebo021999]

is it possible instead of the Vlookup formula, that the value from the Loc_Status sheet should update.

As my comment, jus restore:
.Value = .Value

About pivot table, I am not sure. Could you show how the sheet "Unmatched GRN Report" look like?

 

[aaleem]

Dear bebo021999,

I'm attaching a sample file, the original file has more than 100K records.

Sample sheet.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN
1	Supplier	Supplier Name	Order No	Invc Match Status	Currency Code	Exchange Rate	To Loc	GRN Number	Receive Date	User ID	Company	Virtual Location	Appointment Number	Handle Number	Quantity	Total Unit Cost	Grouping	Converted AED	Unique.Supplier Code	G/L Class	Pmt Trm	Description	Net Days to Pay	Unique Invoice Dates	Calc.Due Date	AgeFromDate	Remarks	Supplier Class	Merged Invoice No.	Comb.Status	Com.Handle Ref	Current Approver	Company.1	Entity.Name	Entity.Entity_Grouping	Username	User job desc	Dept	Dept.1	Responsible
2	123297701	Liverpool LLC	8420040	U	SAR	1.0211544	4335	108952011	8-May-2022						45	4880.43	DSD	4,983.67	1232977	OSO	090	Net 90 Days	90	44689	44779	-67	Not Yet Due	Others
3	123297701	Liverpool LLC	8422178	U	SAR	1.0211544	4323	108958950	12-May-2022					0.9	485	35962.164	DSD	36,722.92	1232977	OSO	090	Net 90 Days	90	44693	44783	-71	Not Yet Due	Others
4	123297701	Liverpool LLC	8416645	U	SAR	1.0211544	4324	108958739	12-May-2022						24	2135.376	DSD	2,180.55	1232977	OSO	090	Net 90 Days	90	44693	44783	-71	Not Yet Due	Others
5	123297701	Liverpool LLC	8420058	U	SAR	1.0211544	4324	108958737	12-May-2022						474	39700.206	DSD	40,540.04	1232977	OSO	090	Net 90 Days	90	44693	44783	-71	Not Yet Due	Others
6	123297701	Liverpool LLC	8420294	U	SAR	1.0211544	4324	108958742	12-May-2022						89	13099.833	DSD	13,376.95	1232977	OSO	090	Net 90 Days	90	44693	44783	-71	Not Yet Due	Others
7	123297701	Liverpool LLC	8422171	U	SAR	1.0211544	4335	108958632	12-May-2022						424	37383.777	DSD	38,174.61	1232977	OSO	090	Net 90 Days	90	44693	44783	-71	Not Yet Due	Others
8	11534003	EM Trading LLC	8428500	U	AED	1	1218	108960951	14-May-2022						12	1018.332	DSD	1,018.33	115340	LST	075	Credit 75 Days	75	44695	44770	-58	Not Yet Due	Others
9	123297701	Liverpool LLC	8422179	U	SAR	1.0211544	4332	108961692	14-May-2022						153	13336.407	DSD	13,618.53	1232977	OSO	090	Net 90 Days	90	44695	44785	-73	Not Yet Due	Others
10	123297701	Liverpool LLC	8422167	U	SAR	1.0211544	4330	108963170	15-May-2022						438	41721.615	DSD	42,604.21	1232977	OSO	090	Net 90 Days	90	44696	44786	-74	Not Yet Due	Others
11	15250009	Beidoun Contracting	8426459	U	KWD	0.082494638	8802	108963034	15-May-2022						8	431.46	DSD	35.59	152500	OST	60	Credit 60 Days	60	44696	44756	-44	Not Yet Due	Others
12	10007503	Intl. Est.	8428326	U	AED	1	1214	108964311	16-May-2022						18	1195.173	DSD	1,195.17	100075	OST	P08	Payment 90 Days (P)	90	44697	44787	-75	Not Yet Due	Others
13	10010407	GT IHE	8428443	U	AED	1	1229	108965327	17-May-2022						90	17002.44	DSD	17,002.44	100104	GRP	P04	Payment 90 Days	90	44698	44788	-76	Not Yet Due	Others
14	127075103	ORIENTAL DE LA PARFUMERIE	8429093	U	AED	1	8502	108966261	17-May-2022						8	2237.544	DSD	2,237.54	1270751	LST	060	Credit 60 Days	60	44698	44758	-46	Not Yet Due	Others
15	127526704	Aramex stocks	8422812	U	AED	1	8502	108965386	17-May-2022						7	1154.979	DSD	1,154.98	1275267	LST	090	Net 90 Days	90	44698	44788	-76	Not Yet Due	Others
16	128054506	Jindal General Trading Co LLC	8424444	U	AED	1	8502	108965752	17-May-2022						29	7088.17041	DSD	7,088.17	1280545	LST	090	Net 90 Days	90	44698	44788	-76	Not Yet Due	Others
17	123297701	Liverpool LLC	8416644	U	SAR	1.0211544	4325	108966361	17-May-2022						24	2135.376	DSD	2,180.55	1232977	OSO	090	Net 90 Days	90	44698	44788	-76	Not Yet Due	Others
18	123297701	Liverpool LLC	8420295	U	SAR	1.0211544	4325	108966358	17-May-2022						71	10275.687	DSD	10,493.06	1232977	OSO	090	Net 90 Days	90	44698	44788	-76	Not Yet Due	Others
19	46026505	Liverpool Middle East FZE	8420057	U	KWD	0.082494638	8741	108967957	18-May-2022						11	82.674	DSD	6.82	460265	LSO	P03	Payment 60 Days	60	44699	44759	-47	Not Yet Due	Others
Unmatched GRN Report

Cell Formulas
Range	Formula
R2:R19	R2	=+[@[Total Unit Cost]]*[@[Exchange Rate]]

kind regards
aleem

 

[bebo021999]

and, also "Loc_Status" sheet?

 

[aaleem]

Dear bebo021999

please find attached the other sample sheet.

thanks
aleem

Sample sheet.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1	To Loc	Comb.Status	Com.Handle Ref	Current Approver	Company.1	Entity.Name	Entity.Entity_Grouping	Username	User job desc	Dept	Dept.1	Responsible
2	101	Pending with Warehouse-GRN showing in Microstrategy/No Handles					Ounass			Logistics	Logistics	Dee
3	1214	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
4	1218	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
5	1229	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
6	201	Pending with Warehouse-GRN showing in Microstrategy/No Handles					B&M			Logistics	Logistics	Dee
7	2416	Pending with Stores- Drag and drop not done/Handle not created					B&M			Stores	Stores	Stores
8	2419	Pending with Stores- Drag and drop not done/Handle not created					B&M			Stores	Stores	Stores
9	301	Pending with Warehouse-GRN showing in Microstrategy/No Handles					B&M			Logistics	Logistics	Dee
10	3764	Pending with Stores- Drag and drop not done/Handle not created					B&M			Stores	Stores	Stores
11	4020	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
12	4323	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
13	4324	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
14	4325	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
15	4330	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
16	4332	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
17	4335	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
18	501	Pending with Warehouse-GAC					Beauty			Logistics	Logistics	Dee
19	6824	Pending with Stores- Drag and drop not done/Handle not created					B&M			Stores	Stores	Stores
20	6911	Pending with Stores- Drag and drop not done/Handle not created					B&M			Stores	Stores	Stores
21	701	Pending with Warehouse-GRN showing in Microstrategy/No Handles					Beauty			Logistics	Logistics	Dee
22	801	Pending with Warehouse-GRN showing in Microstrategy/No Handles					Beauty			Logistics	Logistics	Dee
23	8502	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
24	8741	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
25	8742	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
26	8802	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
27	8302	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
28	8315	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
29	4341	Pending with Stores- Drag and drop not done/Handle not created					Beauty			Stores	Stores	Stores
30	6823	Pending with Stores- Drag and drop not done/Handle not created					B&M			Stores	Stores	Stores
Loc_Status

 

[bebo021999]

Try to test with plain sheets that you gave (without Pivot)

Option Explicit
Sub VlookupLocation()
Dim authorWs As Worksheet, detailsWs As Worksheet
Dim authorsLastRow As Long, detailsLastRow As Long, x As Long, col
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)
authorWs.Cells.AutoFilter field:=30, Criteria1:="" ' Create an autofilter for column AD =""
    On Error Resume Next
    For Each col In Array(2, 5, 7, 10, 11, 12) ' loop for each column_index of VLOOKUP formula
        With authorWs.Range(Cells(2, 28 + col), Cells(authorsLastRow, 28 + col))
            .Formula = "=VLOOKUP(G2,Loc_Status!$A$2:$L$" & detailsLastRow & "," & col & ",0)"
            .Value = .Value
        End With
    Next
authorWs.AutoFilterMode = False ' remove Autofilter
End Sub

It seems OK

 

[aaleem]

Dear bebo021999,

thank you so much, yes this is working fine, I have converted the table to a range then it is working.
Also, the time has improved a lot, it is now running in a few seconds only.

Thank you so much for your help.

kind regards
Aleem

 

[offthelip]

when faced by this sort of problem you might want to look at dictionaries which can do exactly the same thing and are reliably very fast, see this thread, which reduced a macro that took 1 hour 20 min utes to 10 seconds:
How to reduce number of loops in VBA