Using scripting dictionary to do a sumifs

**welchs101** · 10-23-2014, 06:55 AM

hi,

i am enclosing a test macro. In this macro i create a dictionary object to count the number of processA and processB values for a given ID.

For some reason it is not working

any ideas?

**romperstomper** · 10-23-2014, 06:59 AM

What do you think dic_InFl_SiteIds should be?

**welchs101** · 10-23-2014, 07:07 AM

sorry ..........it should be "dic_Ids"

**romperstomper** · 10-23-2014, 07:15 AM

I figured. Would you also care to be a little more specific than "not working"?

**welchs101** · 10-23-2014, 07:29 AM

the first time through when i find an ID that is not in the dictionary i add it to the dictionary like this

dic_Ids.Item(ID_array(LC1, 1)) = Array(LC1, 0, 0)
        dic_Ids.Item(ID_array(LC1, 1))(1) = ProcA_array(LC1, 1)
        dic_Ids.Item(ID_array(LC1, 1))(2) = ProcB_array(LC1, 1)

First line adds it to dictionary and 2nd/3rd line re-assigns values in procA and procB to dictionary.......but for some reason its not updating. it stays at zero even if "ProcA_array(LC1, 1)=1"

**romperstomper** · 10-23-2014, 08:04 AM

The reason for the code not working is that dic_Ids.Item(ID_array(LC1, 1)) returns a copy of the array and that's what you change. You need to use something like this:

Sub Main()


    Dim fl_macro              As String
    Dim input_fl_last_row     As Long
    Dim vTemp

    fl_macro = ThisWorkbook.Name

    Set Input_to_copy = Workbooks(fl_macro).Worksheets("Sheet2")
    Set output_sht = Workbooks(fl_macro).Worksheets("Sheet3")

    output_sht.Cells.ClearContents

    input_fl_last_row = 3689

    'create arrays of required header cols
    With Input_to_copy
        ID_array = .Range(.Cells(1, 1), .Cells(input_fl_last_row, 1)).Value
        ProcA_array = .Range(.Cells(1, 2), .Cells(input_fl_last_row, 2)).Value
        ProcB_array = .Range(.Cells(1, 3), .Cells(input_fl_last_row, 3)).Value
    End With

    'create dictionary of SiteId values from input file
    Set dic_Ids = CreateObject("scripting.dictionary")
    dic_Ids.CompareMode = 1
    '
    'add items to dictionary.
    For LC1 = 2 To UBound(ID_array, 1)
        If dic_Ids.Exists(ID_array(LC1, 1)) Then

            'these msgbox values are in here to help identify whats going on
            MsgBox "in exists " & ID_array(LC1, 1)
            MsgBox "current count E is " & dic_Ids.Item(ID_array(LC1, 1))(1)
            MsgBox "current count F is " & dic_Ids.Item(ID_array(LC1, 1))(2)

            '1st=row of first instance, 2nd will be sum of col B and 3rd will be sum of col C
            vTemp = dic_Ids.Item(ID_array(LC1, 1))
            vTemp(1) = vTemp(1) + ProcA_array(LC1, 1)
            vTemp(2) = vTemp(2) + ProcB_array(LC1, 1)
            dic_Ids.Item(ID_array(LC1, 1)) = vTemp

            'if item is not in the dictionary then add it and create additional records with it
        ElseIf Not dic_Ids.Exists(ID_array(LC1, 1)) Then
            '1st=row of first instance, 2nd will be sum of col B and 3rd will be sum of col C
            dic_Ids.Item(ID_array(LC1, 1)) = Array(LC1, ProcA_array(LC1, 1), ProcB_array(LC1, 1))

            'these msgbox values are in here to help identify whats going on
            MsgBox "in NOTTT exists " & ID_array(LC1, 1)
            MsgBox "current count E is " & dic_Ids.Item(ID_array(LC1, 1))(1)
            MsgBox "current count F is " & dic_Ids.Item(ID_array(LC1, 1))(2)

        End If
    Next LC1

    temp_array = dic_Ids.Items

    MsgBox "lkjlk"

End Sub

**romperstomper** · 10-23-2014, 07:57 AM

Why don't you just use a pivot table?

**welchs101** · 10-23-2014, 08:25 AM

thanks.

Based on your code i also came up with a soln.

Basically you CAN NOT do this assignment and i dont know why:

dic_Ids.Item(ID_array(LC1, 1))(0) = LC1
      dic_Ids.Item(ID_array(LC1, 1))(1) = ProcA_array(LC1, 1)
      dic_Ids.Item(ID_array(LC1, 1))(2) = ProcB_array(LC1, 1)

but you CAN do this type of assignment:

dic_Ids.Item(ID_array(LC1, 1)) = Array(LC1, ProcA_array(LC1, 1), ProcB_array(LC1, 1))

i am also enclosing the code i came up with .........thanks again for your help.

**romperstomper** · 10-23-2014, 08:36 AM

For the reason I gave you. This:

dic_Ids.Item(ID_array(LC1, 1))

returns a copy of the array in the Dictionary, so when you do this:

dic_Ids.Item(ID_array(LC1, 1))(0) = LC1

you only update the copy.

**welchs101** · 10-23-2014, 08:55 AM

but why does this work then:

dic_Ids.Item(ID_array(LC1, 1)) = Array(LC1, ProcA_array(LC1, 1), ProcB_array(LC1, 1))

wouldnt your comments about the "copy" still apply? thanks again for your help

**romperstomper** · 10-23-2014, 09:12 AM

No because you are assigning the array directly to the dictionary item. In the former case, you have to return the (copy of the) array before you can access an element of it (to read or write).

**MickG** · 10-23-2014, 09:16 AM

Another option see code comments:-
Results start column "G"


Option Explicit

'***********************************************************************
'***********************************************************************
'     Returns the character equivalent of a col num
'***********************************************************************
'***********************************************************************
Function alphacol(numcol As Long)
Dim colchar As String
If numcol > 0 And numcol < 257 Then
        If numcol > 26 Then
            colchar = Chr(64 + Int((numcol - 1) / 26))
            colchar = colchar & Chr(65 + ((numcol - 1) Mod 26))
        Else: colchar = Chr(65 + ((numcol - 1) Mod 26))
        End If
    End If
alphacol = colchar
End Function

'***********************************************************************
'***********************************************************************
'     Main
'***********************************************************************
'***********************************************************************
Sub Main()
Dim Input_to_copy As Worksheet
Dim output_sht As Worksheet
Dim ID_array As Variant
Dim ProcA_array As Variant
Dim ProcB_array As Variant
Dim fl_macro As String
Dim input_fl_last_row As Long
Dim Dic_Ids As Object
Dim LC1 As Long
Dim Temp_Array As Variant
Dim Q As Variant
fl_macro = ThisWorkbook.Name


Set Input_to_copy = Workbooks(fl_macro).Worksheets("Sheet2")
Set output_sht = Workbooks(fl_macro).Worksheets("Sheet3")

output_sht.Cells.ClearContents


input_fl_last_row = 3689

'create arrays of required header cols
ID_array = Input_to_copy.Range(alphacol(1) & 1 & ":" & alphacol(1) & input_fl_last_row).Value
ProcA_array = Input_to_copy.Range(alphacol(2) & 1 & ":" & alphacol(2) & input_fl_last_row).Value
ProcB_array = Input_to_copy.Range(alphacol(3) & 1 & ":" & alphacol(3) & input_fl_last_row).Value

'create dictionary of SiteId values from input file
Set Dic_Ids = CreateObject("scripting.dictionary")
Dic_Ids.CompareMode = 1
'
'add items to dictionary.
For LC1 = 2 To UBound(ID_array, 1)
    If Dic_Ids.Exists(ID_array(LC1, 1)) Then
        
        'these msgbox values are in here to help identify whats going on
        'MsgBox ("in exists " & ID_array(LC1, 1))
        'MsgBox ("current count E is " & Dic_Ids.Item(ID_array(LC1, 1))(1))
       ' MsgBox ("current count F is " & Dic_Ids.Item(ID_array(LC1, 1))(1))
        
        '1st=row of first instance, 2nd will be sum of col B and 3rd will be sum of col C
      '######################
       'You need to assign the Dictionary items to a variant variable "Q" here!!
        Q = Dic_Ids.Item(ID_array(LC1, 1))
      'The add the "Proc-- array" here !!
        Q(1) = Q(1) + ProcA_array(LC1, 1)
        Q(2) = Q(2) + ProcB_array(LC1, 1)
        'Then Update the dictionary by assigning the variable "Q" back to the dictionary"
        Dic_Ids.Item(ID_array(LC1, 1)) = Q
        '########################
        'Dic_Ids.Item(ID_array(LC1, 1))(1) = Dic_Ids.Item(ID_array(LC1, 1))(1) + ProcA_array(LC1, 1)
        'Dic_Ids.Item(ID_array(LC1, 1))(2) = Dic_Ids.Item(ID_array(LC1, 1))(2) + ProcB_array(LC1, 1)

    
    
    'if item is not in the dictionary then add it and create additional records with it
    ElseIf Not Dic_Ids.Exists(ID_array(LC1, 1)) Then
        '1st=row of first instance, 2nd will be sum of col B and 3rd will be sum of col C
        Dic_Ids.Item(ID_array(LC1, 1)) = Array(LC1, 0, 0)
        Dic_Ids.Item(ID_array(LC1, 1))(1) = ProcA_array(LC1, 1)
        Dic_Ids.Item(ID_array(LC1, 1))(2) = ProcB_array(LC1, 1)
        
        'these msgbox values are in here to help identify whats going on
       ' MsgBox ("in NOTTT exists " & ID_array(LC1, 1))
        'MsgBox ("current count E is " & Dic_Ids.Item(ID_array(LC1, 1))(1))
        'MsgBox ("current count F is " & Dic_Ids.Item(ID_array(LC1, 1))(2))

    End If
Next LC1

Temp_Array = Application.Transpose(Application.Transpose(Dic_Ids.Items))
Range("H1").Resize(UBound(Temp_Array), 3) = Temp_Array
Range("G1").Resize(UBound(Temp_Array)) = Application.Transpose(Dic_Ids.keys)
'MsgBox ("lkjlk")
End Sub

Regards Mick

**romperstomper** · 10-23-2014, 09:28 AM

Mick,

Other than using Q rather than vTemp, is that different from mine? (BTW, you forgot to alter the bit in the Else part)

**MickG** · 10-23-2014, 09:42 AM

To be Honest I've only just seen your code. If I'd seen it before I posted , I would not have bothered !!!!!

**romperstomper** · 10-23-2014, 09:56 AM

No worries - thought I was missing something.

**welchs101** · 10-23-2014, 10:42 AM

i hope you dont think i am totally stupid but i just dont get this statement

"In the former case, you have to return the (copy of the) array before you can access an element of it (to read or write)"

i just dont see why i cant make this type of assignment

dic_Ids.Item(ID_array(LC1, 1))(1) = ProcA_array(LC1, 1)

i can display to the screen the contents of this

dic_Ids.Item(ID_array(LC1, 1))(1) = ProcA_array(LC1, 1)

so why cant i make an assignment to it.........just dont get the "copy thing"

granted we have a fix i am just trying to understand why could not do what i thought should work

**romperstomper** · 10-23-2014, 10:58 AM

Whenever you put an array into a Dictionary, or get one out, you are dealing with a copy. So if you create an array variable, load it into a Dictionary and then alter the original array variable, the Dictionary contents don't change.

In order to access any element of the array, you have to return the whole array first. In the case of your code, there is an implicit variable created similar to my vTemp variable, which is a copy of what is in the Dictionary (that's just the way it works).

Reading the copy (e.g. outputting to messages/immediate window) is fine because it's a copy - so the contents are the same as the array in the Dictionary.

Writing to an element also changes the copy only.

The only way to update the array contents is to assign a new array back to the Dictionary item.

I don't really know how else to put it I'm afraid.

BTW, the same is true of the Collection object.

**welchs101** · 10-23-2014, 11:23 AM

thanks......that does help a little more.......

**Leith Ross** · 10-23-2014, 10:13 PM

Hello Welchs101,

I use this technique a lot. Here is my version of the macro. It outputs the results on "Sheet3".

Sub Macro1()

    Dim Cell    As Range
    Dim Data    As Variant
    Dim Dict    As Object
    Dim Key     As String
    Dim Item    As Variant
    Dim n       As Long
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = Worksheets("Sheet2")
        
        Set Rng = Wks.Range("A1").CurrentRegion
        
        Set Rng = Intersect(Rng, Rng.Offset(1, 0))
        
        Set Dict = CreateObject("Scripting.Dictionary")
        Dict.CompareMode = vbTextCompare
        
            For Each Cell In Rng.Columns(1).Cells
                Key = Cell
                If Key <> "" Then
                    If Dict.Exists(Key) = False Then
                        ReDim Data(2)
                            Data(0) = Key
                            Data(1) = Cell.Offset(0, 1)
                            Data(2) = Cell.Offset(0, 2)
                        Dict.Add Key, Data
                    Else
                        Data = Dict(Key)
                            Data(1) = Data(1) + Cell.Offset(0, 1)
                            Data(2) = Data(2) + Cell.Offset(0, 2)
                        Dict(Key) = Data
                    End If
                End If
            Next Cell
            
        For Each Item In Dict.Items
            Worksheets("Sheet3").Range("A1:C1").Offset(n, 0).Value = Item
            n = n + 1
        Next Item
            
End Sub

Using scripting dictionary to do a sumifs

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Re: Using scripting dictionary to do a sumifs

Thread Information

Users Browsing this Thread

Similar Threads

need help with scripting dictionary

[SOLVED] Using Dictionary in VBA scripting

Scripting Dictionary

[SOLVED] Scripting Dictionary

[SOLVED] Scripting Dictionary help

Bookmarks

Bookmarks

Posting Permissions