CODEWITHSUNDEEP
vbaexceldictionary
JiteJagboro
JiteJagboro

Reputation: 33

Save Range to dictionary with Excel VBA

I have an excel sheet with the following rows and columns. I will like to save this into a dictionary so that i can use the year in column A as the key to reference each rows and then add row values with same year in column A.

Please how can I get this done since am stuck on this code. Thanks 

A  ....|.. B..| ..C..|..D.                                                                            
 2014  | UNION| 5677 | 4556                  
 2014  | UNION| 5677 | 4556                
 2015  | BEST | 5677 | 4556              
 2015  | BEST | 5677 | 4556

Here is my codes.

Sub AnyThing()
Dim lastrow_DE As Integer

lastrow_DE = DEsheet.Cells(DEsheet.Rows.Count, "E").End(xlUp).Row

DEsheet.Range("A1:L" & lastrow_DE).Select

Selection.AutoFilter field:=2, Criteria1:=Array("UNION", "BEST"), Operator:=xlFilterValues

Selection.AutoFilter field:=5, Criteria1:=Array("2014", "2015"), Operator:=xlFilterValues


Dim rng As Range

Set rng = DEsheet.Range("A2:L" & lastrow_DE).SpecialCells(xlCellTypeVisible)


Dim p As Variant

Dim dict As Scripting.Dictionary

Set dict = New Scripting.Dictionary


For Each p In rng

dict.Add key = p.Items(1).Value, items =p.Items(2).Value, p.Items(3).Value, p.Items(4).Value

Next

Else

End If
End Sub

Upvotes: 1

Views: 8411

Answers (2)

JiteJagboro
JiteJagboro

Reputation: 33

Click Expected result
.....
Click raw data

Column E is Year and date (to be used as dict key) ...Column C is equivalent to best and union column... G,H,I,J,L sums column with similar "year and date + similar column C" ... I am using a dictionary because I can add the data together by running the VBA as more data is added @QHarr

QHarr .. fake data

Upvotes: 0

QHarr
QHarr

Reputation: 84475

You can run something like the code below. You might use a dictionary of dictionaries. I have chosen to create a key which is the concantenation of yearn and your second filter value and then split this out after when writing back to sheet.

Note I have changed your second criteria field to one as you show year as being in column A.

Code:

Option Explicit

Public Sub AnyThing()
    Dim lastrow_DE As Long
    Dim DEsheet As Worksheet
    Set DEsheet = ActiveSheet

    lastrow_DE = DEsheet.Cells(DEsheet.Rows.Count, "E").End(xlUp).Row

    With DEsheet.Range("A1:L" & lastrow_DE)
        .AutoFilter field:=2, Criteria1:=Array("UNION", "BEST"), Operator:=xlFilterValues
        .AutoFilter field:=1, Criteria1:=Array("2014", "2015"), Operator:=xlFilterValues
    End With

    Dim rng As Range, p As Variant, dict As Scripting.Dictionary
    '<== You should add a test here that filter columns contain filter values i.e. there will be visible cells after applying filter
    Set rng = DEsheet.Range("A2:L" & lastrow_DE).SpecialCells(xlCellTypeVisible)
    Set dict = New Scripting.Dictionary

    For Each p In rng.Columns(1).Cells
        If Not dict.Exists(p.Value & "," & p.Offset(, 1)) Then
            dict.Add p.Value & "," & p.Offset(, 1), Application.WorksheetFunction.Sum(p.Offset(, 2).Resize(1, 10))
        Else
            dict(p.Value & "," & p.Offset(, 1)) = dict(p.Value & "," & p.Offset(, 1)) + Application.WorksheetFunction.Sum(p.Offset(, 2).Resize(1, 10))
        End If
    Next p

    Dim key As Variant

    For Each key In dict.Keys
        Debug.Print key & " : " & dict(key)
    Next key

    Sheets.Add

    Dim counter As Long

    With ActiveSheet
        For Each key In dict.Keys
            counter = counter + 1
            .Cells(counter, "A").Resize(1, 2) = Split(key, ",")
            .Cells(counter, "C") = dict(key)

        Next key
    End With

End Sub

Data:

Data

Output:

Immediate window

Immediate window output

Sheet output

Sheet

Upvotes: 4

Related Questions