vba Dictionary - replace vlookup for speed

[Mallesh23]

Hi Team,

I need dictionary help to replace vlookup. as dictionary is faster.
I have dummy data Range("A1:G43") and Expected output is in Range J onward.

Column J (Player Name) is looking up value, trying to learn dictionary with this example. Thanks in advance for your help.

In my Actual data I have 2000 lookup value in Range of ("A1:Z30000") so looking for dictioanary help.


Below is table with expected output.

Book3
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Sr No	Player Name	Period	Team	Test Century	ODI Century	Total			Player Name	Team	Test Century	ODI Century	Total
2	1	Sachin Tendulkar	1989–2013	India	51	49	100			Sachin Tendulkar	India	51	49	`
3	2	Ricky Ponting	1995–2012	Australia	41	30	71			Ricky Ponting	Australia	41	30	71
4	3	Virat Kohli	2008–2020	India	27	43	70			Virat Kohli	India	27	43	70
5	4	Kumar Sangakkara	2000–2015	Sri Lanka	38	25	63			Brian Lara	West Indies	34	19	53
6	5	Jacques Kallis	1995–2014	South Africa	45	17	62			Rahul Dravid	India	36	12	48
7	6	Hashim Amla	2004–2019	South Africa	28	27	55			AB de Villiers	South Africa	22	25	47
8	7	Mahela Jayawardene	1997–2015	Sri Lanka	34	19	53			David Warner	Australia	24	18	42
9	8	Brian Lara	1990–2007	West Indies	34	19	53			Sanath Jayasuriya	Sri Lanka	14	28	42
10	9	Rahul Dravid	1996–2012	India	36	12	48			Chris Gayle	West Indies	25	2	27
11	10	AB de Villiers	2004–2018	South Africa	22	25	47			Gary Kirsten	South Africa	21	26	47
12	11	David Warner	2009–2020	Australia	24	18	42			Adam Gilchrist	Australia	17	26	43
13	12	Sanath Jayasuriya	1989–2011	Sri Lanka	14	28	42			Joe Root	England	16	25	41
14	13	Chris Gayle	1989–2011	West Indies	25	2	27			Kevin Pietersen	England	23	16	39
15	14	Shivnarine Chanderpaul	1989–2011	West Indies	30	11	41			Saeed Anwar	Pakistan	20	19	39
16	15	Ross Taylor	1989–2011	New Zealand	7	0	7			Allan Border	Australia	3	23	26
17	16	Matthew Hayden	1993–2009	Australia	30	10	40			Don Bradman	Australia	29	27	56
18	17	Gary Kirsten	1993–2004	South Africa	21	26	47
19	18	Kane Williamson	1993–2004	New Zealand	13	30	43
20	19	Adam Gilchrist	1996–2008	Australia	17	26	43
21	20	Joe Root	2004–2014	England	16	25	41
22	21	Kevin Pietersen	2004–2014	England	23	16	39
23	22	Javed Miandad	1975–1996	Pakistan	23	15	38
24	23	Aravinda de Silva	1975–1996	Sri Lanka	11	24	35
25	24	Saeed Anwar	1975–1996	Pakistan	20	19	39
26	25	Gordon Greenidge	1974–1991	West Indies	19	30	49
27	26	Allan Border	1974–1991	Australia	3	23	26
28	27	Don Bradman	1928–1948	Australia	29	27	56
29	28	Mohammad Azharuddin	1928–1948	India	7	15	22
30	29	Graham Gooch	1975–1995	England	20	18	38
31	30	Greg Chappell	1970–1984	Australia	24	28	52
32	31	Marvan Atapattu	1970–1984	Sri Lanka	11	27	38
33	32	Nathan Astle	1970–1984	New Zealand	16	20	36
34	33	Andrew Strauss	1970–1984	England	6	25	31
35	34	Garfield Sobers	1970–1984	West Indies	26	29	55
36	35	David Boon	1970–1984	Australia	5	30	35
37	36	Marcus Trescothick	1970–1984	England	12	17	29
38	37	Ian Bell	1970–1984	England	4	25	29
39	38	David Gower	1970–1984	England	18	22	40
40	39	Shikhar Dhawan	2010–2020	India	7	22	29
41	40	Geoffrey Boycott	1964–1982	England	22	22	44
42	41	Justin Langer	1964–1982	Australia	23	21	44
43	42	V. V. S. Laxman	2000-2014	India	6	23	29
Sheet1

Cell Formulas
Range	Formula
K2	K2	=VLOOKUP($J2,$B$1:$G$43,3,0)
L2:L17	L2	=VLOOKUP($J2,$B$1:$G$43,4,0)
M2:M17	M2	=VLOOKUP($J2,$B$1:$G$43,5,0)
K3:K17	K3	=VLOOKUP(J3,$B$1:$G$43,3,0)
N3:N17	N3	=VLOOKUP($J3,$B$1:$G$43,6,0)

 

[Fluff]

How about

Sub Mallesh()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 2).Resize(, 4)
      Next Cl
      For Each Cl In Range("J2", Range("J" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then Cl.Offset(, 1).Resize(, 4) = .Item(Cl.Value)
      Next Cl
   End With
End Sub

 

[Mallesh23]

Hi Fluff.

Excellent !!!!

I have two questions. 1) how to add eneven columns to items and print those columns.
i.e Column D (Team) and Column G (Total)

2) how to take data into array and add to dictonary.

How to read below value into Dictionary using array.
For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Cl.Offset(, 2).Resize(, 4)
Next Cl


Like , Dim ar as variant
ar = range("a1").currentregion.value

for i = lbound(ar) to ubound(ar)
ar(i) = ....something like this...
next i

Book3
	J	K	L	M	N
1	Player Name	Team	Test Century	ODI Century	Total
2	Sachin Tendulkar	India			100
3	Ricky Ponting	Australia			71
4	Virat Kohli	India			70
5	Brian Lara	West Indies			53
6	Rahul Dravid	India			48
7	AB de Villiers	South Africa			47
8	David Warner	Australia			42
9	Sanath Jayasuriya	Sri Lanka			42
10	Chris Gayle	West Indies			27
11	Gary Kirsten	South Africa			47
12	Adam Gilchrist	Australia			43
13	Joe Root	England			41
14	Kevin Pietersen	England			39
15	Saeed Anwar	Pakistan			39
16	Allan Border	Australia			26
17	Don Bradman	Australia			56
Sheet1

Regards,
mg

 

[Fluff]

No need to pull it into an array, I ran a test on over 90,000 row & it took 1 second.

 

[Mallesh23]

Hi Fluff,

Thanks once again !

Last question on this.

How to add eneven columns to items and print those columns.
i.e Column D (Team) and Column G (Total)


Thanks
mg

 

[Fluff]

How about

Sub Mallesh()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Array(Cl.Offset(, 2), Cl.Offset(, 5))
      Next Cl
      For Each Cl In Range("J2", Range("J" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            Cl.Offset(, 1) = .Item(Cl.Value)(0)
            Cl.Offset(, 4) = .Item(Cl.Value)(1)
         End If
      Next Cl
   End With
End Sub

 

[Mallesh23]

Hi Fluff,

Awwwsomeeee !!! Got as expected it worked, Millions of thanks,?


Regards,
mg

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Mallesh23]

?

 

[CeCeDash]

Hi Fluff,

Will this work on a sheet with 250K rows?

Real Green with code and trying to make this work.

Thanks,

-CeCe

How about

Sub Mallesh()
   Dim Cl As Range
  
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 2).Resize(, 4)
      Next Cl
      For Each Cl In Range("J2", Range("J" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then Cl.Offset(, 1).Resize(, 4) = .Item(Cl.Value)
      Next Cl
   End With
End Sub