Replace vlookup using Array and dictionary

[Mallesh23]

Hi Team,

I want to store my data into Array. column [A:E]

k is my unique values ..... I need to extract matching values from data [A:E]

I know how to get using vlookup.

looking dictionary style. please assist. Thanks

Expected output is in LMN.

Name	English	Maths	Science	Total	Name	Science	Maths	English
Sachin	92	62	100	248	Sachin	100	62	92
Dhoni	80	66	90	236	Yuvraj	94	83	62
Yuvraj	62	83	94	239	Ricky Ponting	95	63	66
Virat	99	79	97	275	Fleming	85	96	99
Steve waugh	81	88	92	261
Ricky Ponting	66	63	95	224
Adam Gilchrist	97	93	83	273
Gayle	70	96	85	251
Fleming	99	96	85	280

thanks
mg

 

[kvsrinivasamurthy]

You mean index formula?
In G2 copied to full range.

=IFERROR(INDEX($B$2:$I$10,MATCH($F2,$A$2:$A$10,0),MATCH(G$1,$B$1:$F$1,0)),"")

 

[dermie_72]

if you use the following formula in L2 and populate across the field, this should do what you want, and if you change a name or heading it will auto update:

=INDEX($A$1:$E$8,MATCH($K2,$A$1:$A$8,0),MATCH(L$1,$A$1:$E$1,0))

 

[Mallesh23]

Hi demie,

I am looking for vba code here.

Thanks

 

[Fuji]

If this is a learning material, (not a good example though)

Sub test()
    Dim a, i&, ii&, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    a = [a1].CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        For ii = 2 To UBound(a, 2)
            dic(Join(Array(a(i, 1), a(1, ii)), Chr(2))) = a(i, ii)
    Next ii, i
    With [l1].CurrentRegion
        .Offset(1, 1).ClearContents
        a = .Value
        For i = 2 To UBound(a, 1)
            For ii = 2 To UBound(a, 2)
                a(i, ii) = dic(Join(Array(a(i, 1), a(1, ii)), Chr(2)))
        Next ii, i
        .Value = a
    End With
End Sub

 

[JEC]

Here an example with a double dictionary. Idea is to check if the name exists in the first dictionary before adding the record to the output dictionary

Sub jec()
 Dim ar, ar2, j As Long
 Dim dic As Object, dic2 As Object
 
 ar = Cells(1).CurrentRegion
 ar2 = Cells(1, 11).CurrentRegion.Columns(1)
 
 Set dic = CreateObject("scripting.dictionary")
 Set dic2 = CreateObject("scripting.dictionary")
 
 For j = 1 To UBound(ar2)
   dic2(ar(j, 1)) = Empty
 Next
 
 For j = 1 To UBound(ar)
   If dic2.exists(ar(j, 1)) Then dic(ar(j, 1)) = Array(ar(j, 1), ar(j, 4), ar(j, 3), ar(j, 2))
 Next
   
 Cells(1, 11).Resize(dic.Count, 4) = Application.Index(dic.items, 0, 0)
End Sub

 

[Alex Blakenburg]

Here an example with a double dictionary. Idea is to check if the name exists in the first dictionary before adding the record to the output dictionary

I am pretty sure that this loop is meant to be loading ar2 not ar.

 For j = 1 To UBound(ar2)
   dic2(ar2(j, 1)) = Empty
 Next

 

[Mallesh23]

Hi All,

Thank you all for your help, I will go with JEC Solution.

I want to print values in different columns,
Read all rows and write different columns as per choice.


example

sheet1.Range("a1:d1000") read values

sheet2.range("A2:A100).unique records
sheet2.range("B2:b100).value = first matching column data
sheet2.range("d2:d100).value = second matching column data
sheet2.range("f2:f100).value = third matching column data
sheet2.range("g2:g100).value = fourth matching values



Thanks
mg

 

[JEC]

@Alex Blakenburg, yes! Correct. Nice catch