Sum of values inside an array if identifier is identical

Question

Scenario: I am trying to build a sub that: - Gets data from a worksheet - Sums values of a column if the id is the same - Check the last columns for a value decrease (from previous to current) and retrieve the one that changed the most - Delete duplicate columns

Data:

+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Name1    | ID1     | Value | Current Level1 | Previous Level1 | Current Level2 | Previous Level2 |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 1  | IDTYPE1 | 100   | 9              | 10              | 9              | 11              |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 2  | IDTYPE2 | 500   | 10             | 14              | 8              | 14              |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 2  | IDTYPE2 | 244   | 9              | 14              | 9              | 14              |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 2a | IDTYPE2 | 378   |                |                 | 9              | 14              |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 3a | IDTYPE3 | 343   | 3              | 9               |                |                 |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 3  | IDTYPE3 | 127   | 5              | 4               | 4              | 5               |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 4s | IDTYPE4 | 213   |                |                 | 4              | 5               |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 4a | IDTYPE4 | 241   | 3              | 5               | 4              | 5               |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+

Output: In theory the output will have the same columns, but duplicate IDs would be aggregated into a single row. And the data for the "Level" columns, would be, for that single row, the lowest value available in the "Current1" (irrespective of each row), aggregated with the lowest level of "Current2" (each associated with their respective "Previous". The name column is to have the first name for that ID that appeared (for "IDTYPE4" it would be "Issue 4s").

Output example:

+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Name1    | ID1     | Value | Current Level1 | Previous Level1 | Current Level2 | Previous Level2 |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 1  | IDTYPE1 | 100   | 9              | 10              | 9              | 11              |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 2  | IDTYPE2 | 1122  | 9              | 14              | 8              | 14              |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 3  | IDTYPE3 | 470   | 3              | 9               | 4              | 5               |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+
| Issue 4s | IDTYPE4 | 454   | 3              | 5               | 4              | 5               |
+----------+---------+-------+----------------+-----------------+----------------+-----------------+

Question: I am trying to do this in form a loop inside an array, as per the code below. But I cannot think of a way to sum up the values if the IDs are the same and still account for the change in "Level". Is there an easier way to do this?

Obs. I tried the SumIf function, but could not properly place it inside the loop.

Code so far:

Dim procdupArray  as Variant
Dim loopvar1 as Integer
Dim w as Workbook
Dim valueSum as Long
Set w = ThisWorkbook
procdupArray = w.Worksheets("Sheet1").UsedRange
For loopvar1 = 2 To UBound(procdupArray, 1) - 1
    If procdupArray(loopvar1, 2) <> procdupArray(loopvar1 + 1, 2) Then
        w.Worksheets("Sheet2").Cells(loopvar1, 1) = procdupArray(loopvar1, 1)
        w.Worksheets("Sheet2").Cells(loopvar1, 2) = procdupArray(loopvar1, 2)
        w.Worksheets("Sheet2").Cells(loopvar1, 3) = procdupArray(loopvar1, 3)
        w.Worksheets("Sheet2").Cells(loopvar1, 4) = procdupArray(loopvar1, 4)
        w.Worksheets("Sheet2").Cells(loopvar1, 5) = procdupArray(loopvar1, 5)
        w.Worksheets("Sheet2").Cells(loopvar1, 5) = procdupArray(loopvar1, 5)
        w.Worksheets("Sheet2").Cells(loopvar1, 5) = procdupArray(loopvar1, 5)

    Else
        valueSum = procdupArray(loopvar1, 7) + procdupArray(loopvar1 + 1, 7)
        If procdupArray(loopvar1, 4) < procdupArray(loopvar1 + 1, 4) then
            w.Worksheets("Sheet2").Cells(loopvar1, 4) = procdupArray(loopvar1, 4)
        End if
        If procdupArray(loopvar1, 5) < procdupArray(loopvar1, 5) then
            w.Worksheets("Sheet2").Cells(loopvar1, 5) = procdupArray(loopvar1, 5)
        End if
        If procdupArray(loopvar1, 6) < procdupArray(loopvar1, 6) then
            w.Worksheets("Sheet2").Cells(loopvar1, 6) = procdupArray(loopvar1, 6)
        End if
        If procdupArray(loopvar1, 6) < procdupArray(loopvar1, 6) then
            w.Worksheets("Sheet2").Cells(loopvar1, 6) = procdupArray(loopvar1, 6)
        End if
     End if
Next loopvar1

Obs2: Another Problem is that this does not properly take into account if there are more than two rows for the same ID.

You could use a dictionary.

SJR
– SJR

2019-09-11 17:57:32 +00:00
Commented Sep 11, 2019 at 17:57 — SJR
– SJR, Commented Sep 11, 2019 at 17:57

Warcupine · Accepted Answer · 2019-09-11 19:42:45Z

1

This uses a dictionary and a class. All the comparisons are done in the class. It creates a new sheet with the data so you can see what it is doing before you erase your data.

Here is the module:

Option Explicit

Sub test()
Dim typedict As Object
Dim ws As Worksheet
Dim iter As Long
Dim lr As Long
Dim i As Long
Dim dataobj As cls_issuedata
Dim key As Variant

Set ws = ThisWorkbook.Sheets("Sheet1")
Set typedict = CreateObject("Scripting.Dictionary")
With ws
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lr
        If Not typedict.exists(.Cells(i, 2).Value) Then ' New Values
            Set dataobj = New cls_issuedata
            dataobj.name = .Cells(i, 1).Value
            dataobj.val = .Cells(i, 3).Value
            dataobj.clevel1 = .Cells(i, 4).Value
            dataobj.plevel1 = .Cells(i, 5).Value
            dataobj.clevel2 = .Cells(i, 6).Value
            dataobj.plevel2 = .Cells(i, 7).Value
            typedict.Add .Cells(i, 2).Value, dataobj
        Else 'Potential Overwriting of Old Values
            typedict(.Cells(i, 2).Value).name = .Cells(i, 1).Value
            typedict(.Cells(i, 2).Value).val = .Cells(i, 3).Value
            typedict(.Cells(i, 2).Value).clevel1 = .Cells(i, 4).Value
            typedict(.Cells(i, 2).Value).plevel1 = .Cells(i, 5).Value
            typedict(.Cells(i, 2).Value).clevel2 = .Cells(i, 6).Value
            typedict(.Cells(i, 2).Value).plevel2 = .Cells(i, 7).Value
        End If
    Next
End With

Set ws = ThisWorkbook.Worksheets.Add
With ws ' New Sheet
    .name = "NEW"
    i = 2
    For Each key In typedict.keys 'Get IDs
        .Cells(i, 1).Value = typedict(key).name
        .Cells(i, 2).Value = key
        .Cells(i, 3).Value = typedict(key).val
        .Cells(i, 4).Value = typedict(key).clevel1
        .Cells(i, 5).Value = typedict(key).plevel1
        .Cells(i, 6).Value = typedict(key).clevel2
        .Cells(i, 7).Value = typedict(key).plevel2
        i = i + 1
    Next
End With

End Sub

And here is the class module, I named it cls_issuedata:

Option Explicit
Private pname As String
Private pval As Long
Private pclevel1 As Long
Private pplevel1 As Long
Private pclevel2 As Long
Private pplevel2 As Long

Public Property Get name() As String
    name = pname
End Property

Public Property Let name(lname As String)
    If pname = "" Then
        pname = lname
    End If

End Property

Public Property Get clevel1() As String
    clevel1 = pclevel1
End Property

Public Property Let clevel1(lclevel1 As String)
    If Not lclevel1 = "" Then
        If lclevel1 > pclevel1 Then
            pclevel1 = lclevel1
        End If
    End If
End Property

Public Property Get plevel1() As String
    plevel1 = pplevel1
End Property

Public Property Let plevel1(lplevel1 As String)
    If Not lplevel1 = "" Then
        If lplevel1 > pplevel1 Then
            pplevel1 = lplevel1
        End If
    End If
End Property

Public Property Get clevel2() As String
    clevel2 = pclevel2
End Property

Public Property Let clevel2(lclevel2 As String)
    If Not lclevel2 = "" Then
        If lclevel2 > pclevel2 Then
            pclevel2 = lclevel2
        End If
    End If
End Property

Public Property Get plevel2() As String
    plevel2 = pplevel2
End Property

Public Property Let plevel2(lplevel2 As String)
    If Not lplevel2 = "" Then
        If lplevel2 > pplevel2 Then
            pplevel2 = lplevel2
        End If
    End If
End Property

Public Property Get val() As Long
    val = pval
End Property

Public Property Let val(lval As Long)
    If pval = 0 Then
        pval = lval
    Else
        pval = pval + lval
    End If
End Property

Public Sub initialize()
    pname = ""
    pval = 0
    pclevel1 = 0
    pplevel1 = 0
    pclevel2 = 0
    pplevel2 = 0
    pchrval = 0
End Sub

answered Sep 11, 2019 at 19:42

Warcupine

4,7203 gold badges18 silver badges27 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

DGMS89 Over a year ago

Many thanks for the answer. Just a couple of question: Is there any difference (in this case) in using Early vs. Late binding for the dictionary object? For the property procedure,what is the difference between Get and Let in this case?

Warcupine Over a year ago

It is generally a good idea to use early binding if you can, the reference would be Microsoft Scripting Runtime. Get allows you to pull the value from the class, let or set if it was an object allows you to place the value into the class.

DGMS89 Over a year ago

Thank you, I will take a look at the reference. One last thing: I am trying to run it, and am getting a "User defined obj not defined" at the Dim dataobj As cls_issuedata, is it because I am placing the call module on the wrong place?

Warcupine Over a year ago

ohh place the class code into a class module and name the module cls_issuedata.

Collectives™ on Stack Overflow

Sum of values inside an array if identifier is identical

1 Answer 1

4 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

4 Comments

Your Answer

Sign up or log in

Post as a guest

Related