VBA Dictionary

[Mallesh23]

Hi Team,


I have Data in range("A1:D9"), I want to extract Scores and Sixes,
in column h and I. I Know how to get it via vlook up in VBA, My data is huge 1lacks row.

I want the result via vba Dictinary/Collection, Just started learning.
Thanks for your help in Advanc

A B C D

Name	Score	Fours	Sixes
Sachin	45	9	7
Virat	135	10	5
Rahul	120	8	8
Rishabh	109	8	5
Rohit	111	10	6
Shikhar	66	8	6
Gayle	106	12	5
Hardik	55	11	9

<colgroup><col width="64" span="4" style="width: 48pt; text-align: center;"> </colgroup><tbody>
</tbody>

Result

G H I

Name	Score	Sixes
Rishabh	109	5
Shikhar	66	6
Hardik	55	9
Sachin	45	7

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>

Thanks
Mallesh

 

[Fluff]

How about

Sub Mallesh23()
   Dim Ary As Variant, Oary As Variant
   Dim r As Long, rr As Long
   
   Ary = Range("A2", Range("A" & Rows.count).End(xlUp).Offset(, 3)).Value2
   Oary = Range("G2", Range("G" & Rows.count).End(xlUp).Offset(, 2)).Value2
   
   For r = 1 To UBound(Oary)
      For rr = 1 To UBound(Ary)
         If Oary(r, 1) = Ary(rr, 1) Then
            Oary(r, 2) = Ary(rr, 2)
            Oary(r, 3) = Ary(rr, 4)
         End If
      Next rr
   Next r
   Range("G2").Resize(UBound(Oary), 3).Value = Oary
End Sub

 

[Mallesh23]

Fluff, Thanks a lot, it worked for me, with this I learned array too.
is it possible to produce same result using Dictionary concept. Thanks in advance

Regards,
Mallesh

 

[Fluff]

Yes, it's possible, but why do you need to use a Dictionary?

 

[Mallesh23]

Hi Fluff,

Thanks for your help, I was looking for a dictionary because I just started learning it.
and I am curious to know,what will be Dictionary Code for this Situation.

Regards,
Mallesh

 

[Domenic]

This example uses early binding, instead of late binding. In addition to being a bit more efficient, it also gives you access to the intellisense. Since it uses early binding, you'll first need to set a reference...

Visual Basic Editor >> Tools >> References >> check/select Microsoft Scritping Runtime

Then try...

Option Explicit

Sub GetScoresAndSixes()


    'declare the variables
    Dim dicTable As Scripting.Dictionary
    Dim strItem As String
    Dim lastRow As Long
    Dim i As Long
    
    'create an instance of the dictionary object
    Set dicTable = New Scripting.Dictionary
    
    'set the compare mode to a case-insensitive comparison
    dicTable.CompareMode = TextCompare
    
    'find the last used row in Column A
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    'loop through each cell in Column A, starting at Row 2
    'add key/item pair to the dictionary object
    For i = 2 To lastRow
        If Not dicTable.Exists(Cells(i, "A").Value) Then 'name does not already exist
            'add name as key, and add concatenated score, fours, and sixes as item
            dicTable.Add Key:=Cells(i, "A").Value, Item:=Cells(i, "B").Value & "|" & Cells(i, "C").Value & "|" & Cells(i, "D").Value
        End If
    Next i
    
    'find the last used row in Column G
    lastRow = Cells(Rows.Count, "G").End(xlUp).Row
    
    'loop through each cell in Column G, starting at Row 2
    For i = 2 To lastRow
        strItem = dicTable.Item(Cells(i, "G").Value) 'use name to find corresponding item
        Cells(i, "H").Value = Split(strItem, "|")(0) 'score
        Cells(i, "I").Value = Split(strItem, "|")(2) 'sixes
    Next i
    
    'clear from memory
    Set dicTable = Nothing
    
End Sub

Hope this helps!