vba - Replace multiple vlookup with Dictionary and Array

Status
Not open for further replies.

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
976
Office Version
  1. 2010
Platform
  1. Windows
Hi Team,

Need array help to Store below piece of code in Array and direct print in Ranges.


Rich (BB code):
With Dict
For Each Cl In Range("k2", Range("k" & 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 
With Dict


I have added actual Code, and My attempted code , and Actual Data Table.

Actual Code Original is as Follows......

Rich (BB code):
Sub Workig_Working_Replace_Vlookup()
   
   Dim Cl As Range
   Dim i As Long     
   Dim rg As Range
  Dim arr As Variant
   Dim arr_out As Variant

   Set rg = Range("A1").CurrentRegion
   Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
   arr = rg.Value
   Dim Dict As New Scripting.dictionary
   
   arr_out = Range("K2", Range("K" & Rows.Count).End(xlUp)).Value
   
   
   'Store Required Columns 4 and 7 as items in dictionary   
   Dict.RemoveAll   
   With Dict
        For i = LBound(arr, 1) To UBound(arr, 1)
                If Not .Exists(arr(i, 2)) Then
                    .Add arr(i, 2), Array(arr(i, 4), arr(i, 7))
                End If
        Next i
       
      
    For Each Cl In Range("k2", Range("k" & 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



'Attempted Code, Which is working , But I have used seperate loops to get ouput.

Rich (BB code):
Sub Attempted_Code_Dict_Array_Replace_Multiple_Vlookup()
    Dim i As Long  
   Dim rg As Range
   Set rg = Range("A1").CurrentRegion
   Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
  
   Dim arr As Variant
   arr = rg.Value
  
  
   Dim arr_out As Variant
   arr_out = Range("K2", Range("K" & Rows.Count).End(xlUp)).Value
  
  
   'Store Required Columns 4 and 7 as items in dictionary
   Dim dict As New Scripting.Dictionary
  
   dict.RemoveAll
  
   With dict
  
'======================================================================'======================================================================
         'Store Column 4 in Items and Print
         For i = LBound(arr, 1) To UBound(arr, 1)
                 If Not .Exists(arr(i, 2)) Then
                     .Add arr(i, 2), arr(i, 4) ', arr(i, 7))
                 End If
         Next i
                 
              
        ' Store Both Single Column into Array and Print
         For i = LBound(arr_out, 1) To UBound(arr_out, 1)
               arr_out(i, 1) = .Item(arr_out(i, 1))
         Next i
        
         End With
      
       Range("L2").Resize(UBound(arr_out, 1)).Value = arr_out
     
'======================================================================
            dict.RemoveAll
            'Store Column 7 in Items and Print
            arr_out = Range("K2", Range("K" & Rows.Count).End(xlUp)).Value
      
       With dict
         For i = LBound(arr, 1) To UBound(arr, 1)
                 If Not .Exists(arr(i, 2)) Then
                     .Add arr(i, 2), arr(i, 7) ', arr(i, 7))
                 End If
         Next i
                 
              
        ' Store Both Single Column into Array and Print
         For i = LBound(arr_out, 1) To UBound(arr_out, 1)
               arr_out(i, 1) = .Item(arr_out(i, 1))
         Next i   
                
          Range("O2").Resize(UBound(arr_out, 1)).Value = arr_out
     
      End With
                
End Sub

Actual Table with Expected Result  , expected result are highlighted in Blue Color.


Multiple Column Look up.xlsx
ABCDEFGHIJKLMNO
1Sr NoPlayer NamePeriodTeamTest CenturyODI CenturyTotalPlayer NameTeamTest CenturyODI CenturyTotal Century
21Sachin Tendulkar1989–2013 India5149100Sachin Tendulkar India100
32Ricky Ponting1995–2012 Australia413071Ricky Ponting Australia71
43Virat Kohli2008–2020 India274370Virat Kohli India70
54Kumar Sangakkara2000–2015 Sri Lanka382563Brian Lara West Indies53
65Jacques Kallis1995–2014 South Africa451762Rahul Dravid India48
76Hashim Amla2004–2019 South Africa282755AB de Villiers South Africa47
87Mahela Jayawardene1997–2015 Sri Lanka341953David Warner Australia42
98Brian Lara1990–2007 West Indies341953Sanath Jayasuriya Sri Lanka42
109Rahul Dravid1996–2012 India361248Chris Gayle West Indies27
1110AB de Villiers2004–2018 South Africa222547Gary Kirsten South Africa47
1211David Warner2009–2020 Australia241842Adam Gilchrist Australia43
1312Sanath Jayasuriya1989–2011 Sri Lanka142842Joe Root England41
1413Chris Gayle1989–2011 West Indies25227Kevin Pietersen England39
1514Shivnarine Chanderpaul1989–2011 West Indies301141Saeed Anwar Pakistan39
1615Ross Taylor1989–2011New Zealand707Allan Border Australia26
1716Matthew Hayden1993–2009 Australia301040Don Bradman Australia56
1817Gary Kirsten1993–2004 South Africa212647
1918Kane Williamson1993–2004 New Zealand133043
2019Adam Gilchrist1996–2008 Australia172643
2120Joe Root2004–2014 England162541
2221Kevin Pietersen2004–2014 England231639
2322Javed Miandad1975–1996 Pakistan231538
2423Aravinda de Silva1975–1996 Sri Lanka112435
2524Saeed Anwar1975–1996 Pakistan201939
2625Gordon Greenidge1974–1991 West Indies193049
2726Allan Border1974–1991 Australia32326
2827Don Bradman1928–1948 Australia292756
2928Mohammad Azharuddin1928–1948 India71522
3029Graham Gooch1975–1995 England201838
3130Greg Chappell1970–1984 Australia242852
3231Marvan Atapattu1970–1984 Sri Lanka112738
3332Nathan Astle1970–1984 New Zealand162036
3433Andrew Strauss1970–1984 England62531
3534Garfield Sobers1970–1984 West Indies262955
3635David Boon1970–1984 Australia53035
3736Marcus Trescothick1970–1984 England121729
3837Ian Bell1970–1984 England42529
3938David Gower1970–1984 England182240
4039Shikhar Dhawan2010–2020India72229
4140Geoffrey Boycott1964–1982 England222244
4241Justin Langer1964–1982 Australia232144
4342V. V. S. Laxman2000-2014 India62329
Sheet1
Thanks mg
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Duplicate VBA array help-

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).
 
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,215,580
Messages
6,125,653
Members
449,245
Latest member
PatrickL

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