0 votes
in VBA by Expert (848 points)

Hello everyone

I have two columns: first for data that is needed to extract unique values from and the second column has values that need to be summed

I have used this code that extracts the unique and sum the totals

Sub Test()
    Dim ws As Worksheet, dic As Object, a, s As String, i As Long, m As Long

    Set ws = ThisWorkbook.Sheets(1)
    Set dic = CreateObject("Scripting.Dictionary")
    a = ws.Range("A2:B" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value

    For i = LBound(a, 1) To UBound(a, 1)
        s = a(i, 1)
        If Not dic.Exists(s) Then dic(s) = Array(, 0)
        dic(s) = Array(a(i, 1), dic(s)(1) + a(i, 2))
    Next i

    Application.ScreenUpdating = False
        With ws
            .Range("F3:G1000").ClearContents
            .Range("G3").Resize(dic.Count, 2).Value = Application.Transpose(Application.Transpose(dic.items))
        End With
    Application.ScreenUpdating = True
End Sub

How can I add a count part as third column ... I mean to count the items for each item?

 

Another point if possible: Is there a way to convert the dictionary items into an array instead of populating the output to the worksheet?

1 Answer

+1 vote
by Super Expert (2.9k points)
selected by
 
Best answer

To add a count element to your dictionary, you simply need to expand the array function to add an extra argument. You do this by changing the 2 lines defining the dictionary in your For Loop, like this:

        If Not dic.Exists(s) Then dic(s) = Array(, 0, 0)
        dic(s) = Array(a(i, 1), dic(s)(1) + a(i, 2), dic(s)(2) + 1)

Notice the newly added counter dic(s)(2) + 1 in the 3rd argument. This adds 1 to the 3rd element of the array each time a new element is added to your existing dictionary key.

After you do this, you need to change your .Resize property of the Range object to reflect 3 columns, like this:

            .Range("G3").Resize(dic.Count, 3).Value = Application.Transpose(Application.Transpose(dic.items))

Once you do these steps, here's what the final macro would look like (I also updated the ClearContents argument to clear out all 3 columns instead of the first two):

Sub Test()
    Dim ws As Worksheet, dic As Object, a, s As String, i As Long, m As Long

    Set ws = ThisWorkbook.Sheets(1)
    Set dic = CreateObject("Scripting.Dictionary")
    a = ws.Range("A2:B" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value

    For i = LBound(a, 1) To UBound(a, 1)
        s = a(i, 1)
        If Not dic.Exists(s) Then dic(s) = Array(, 0, 0)
        dic(s) = Array(a(i, 1), dic(s)(1) + a(i, 2), dic(s)(2) + 1)
    Next i

    Application.ScreenUpdating = False
        With ws
            .Range("G3:I1000").ClearContents
            .Range("G3").Resize(dic.Count, 3).Value = Application.Transpose(Application.Transpose(dic.items))
        End With
    Application.ScreenUpdating = True
End Sub

To answer your second question, the .items method of a dictionary (dic.items) IS an array so you can navigate it just like you would any other array. In the macro above, it's a 1D array where each element of the array stores 3 values (unique items, the sum of the 2nd column of items, the count of the number of items in each unique category). 

To prove this to yourself, make a variant array. Let's call it v. Set v equal to the dic.items array, like this:

v = dic.items

Add a "Watch" to this variable and stop your macro after you assign the values to v. The Watches window will confirm the v array has the following structure:

VBA Dictionary Items to Array

by Expert (848 points)
Thank you very much for this awesome explanation. Very simple and effective.

How this 1D array be converted to 2D array away from using Application Transpose?

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

Looking for something else? Hire our professional VBA Help, instead.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

ParserMonster $25 Amazon Gift Card
Hightree $10 Amazon Gift Card
Thales1 $10 Amazon Gift Card
runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...