CODEWITHSUNDEEP
excelvbasum
Eduards
Eduards

Reputation: 68

VBA Sum cells values from specific column if value in another column = Specific

I am trying to sum values in column "I" and delete duplicate rows if value in column "E" is the same and value in column "G" is "Kede".

I have this piece of code that I don't fully understand that I'm trying to modify for my needs. Originally this code was looking for duplicate values in column "E" and summing values in column "I" deleting the duplicate rows.


'Declare variables
Dim AcSh As Worksheet, LastRow As Long, dict As Object
Dim rngDel As Range, arrE, arrInt, arrI, i As Long, dKey
 
Set AcSh = ActiveSheet
LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
 
arrE = AcSh.Range("E2:E" & LastRow).Value
Set dict = CreateObject("Scripting.Dictionary")
 
'Sum and delete duplicates
On Error Resume Next
For i = 1 To UBound(arrE)

    If Not dict.Exists(arrE(i, 1)) Then
    dict.Add arrE(i, 1), AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
    Else
    arrInt = Split(dict(arrE(i, 1)), "|")
    dict(arrE(i, 1)) = arrInt(0) & "|" & CDbl(arrInt(1)) + CDbl(AcSh.Range("I" & i + 1).Value)
    
    If rngDel Is Nothing Then
    Set rngDel = AcSh.Range("E" & i + 1)
    Else
    Set rngDel = Union(rngDel, AcSh.Range("E" & i + 1))
    End If
    End If
    
Next i
 
On Error Resume Next
ReDim arrI(1 To LastRow, 1 To 1)

    For Each dKey In dict.keys()
    arrInt = Split(dict.Item(dKey), "|")
    arrI(Range(arrInt(0)).Row - 1, 1) = CDbl(arrInt(1))
    Next
    If Not rngDel Is Nothing Then
    AcSh.Range("I2").Resize(LastRow - 1, 1).Value = arrI
    rngDel.EntireRow.Delete
    End If

And this is what I have so far


'Declare variables
     Dim AcSh As Worksheet, LastRow As Long, dict As Object
     Dim rngDel As Range, arrG, arrInt, arrI, i As Long, dKey
 
     Set AcSh = ActiveSheet
     LastRow = AcSh.Range("G" & AcSh.Rows.Count).End(xlUp).Row
 
     arrG = AcSh.Range("G2:G" & LastRow).Value
     Set dict = CreateObject("Scripting.Dictionary")

'Sum and delete duplicates
On Error Resume Next
For i = 1 To UBound(arrG)

If Not dict.Exists(arrG(i, 1)) And ThisWorkbook.Worksheets("BOM").Range(i, G).Value = "Kede" Then

dict.Add arrG(i, 1), AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
Else:
arrInt = Split(dict(arrG(i, 1)), "|")
dict(arrG(i, 1)) = arrInt(0) & "|" & CDbl(arrInt(1)) + CDbl(AcSh.Range("I" & i + 1).Value)
    
    If rngDel Is Nothing Then
    Set rngDel = AcSh.Range("G" & i + 1)
    Else:
    Set rngDel = Union(rngDel, AcSh.Range("G" & i + 1))
    End If
End If

Next i

On Error Resume Next
ReDim arrI(1 To LastRow, 1 To 1)

For Each dKey In dict.keys()
    arrInt = Split(dict.Item(dKey), "|")
    arrI(Range(arrInt(0)).Row - 1, 1) = CDbl(arrInt(1))
Next

If Not rngDel Is Nothing Then
AcSh.Range("I2").Resize(LastRow - 1, 1).Value = arrI
rngDel.EntireRow.Delete
End If

So basically I am trying to add one more criteria to original code that would also look for if the value in column "G" is "Kede". Could someone, please, help me modify this code and explain it more clearly to me?

Upvotes: 0

Views: 575

Answers (2)

Ben Mega
Ben Mega

Reputation: 522

If I understand correctly, you would like to ignore and remove and rows without "Kede" in column G. If so, this code should do the trick by removing them at the beginning.

    'Declare variables
    Dim AcSh As Worksheet, LastRow As Long, dict As Object
    Dim rngDel As Range, arrE, arrInt, arrI, i As Long, dKey
     
 
    Set AcSh = ActiveSheet
    LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
    
    'Remove non-Kede rows and reset LastRow
    For i = LastRow + 1 To 2 Step -1
        If AcSh.Range("G" & i).Value <> "Kede" Then AcSh.Range("G" & i).EntireRow.Delete
    Next i
    LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
    
    arrE = AcSh.Range("E2:E" & LastRow).Value
    Set dict = CreateObject("Scripting.Dictionary")
     
     
    'Sum and delete duplicates
    On Error Resume Next
    For i = 1 To UBound(arrE)
    
        If Not dict.Exists(arrE(i, 1)) Then
        dict.Add arrE(i, 1), AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
        Else
        arrInt = Split(dict(arrE(i, 1)), "|")
        dict(arrE(i, 1)) = arrInt(0) & "|" & CDbl(arrInt(1)) + CDbl(AcSh.Range("I" & i + 1).Value)
        
        If rngDel Is Nothing Then
        Set rngDel = AcSh.Range("E" & i + 1)
        Else
        Set rngDel = Union(rngDel, AcSh.Range("E" & i + 1))
        End If
        End If
        
    Next i
     
    On Error Resume Next
    ReDim arrI(1 To LastRow, 1 To 1)

    For Each dKey In dict.keys()
    arrInt = Split(dict.Item(dKey), "|")
    arrI(Range(arrInt(0)).Row - 1, 1) = CDbl(arrInt(1))
    Next
    If Not rngDel Is Nothing Then
    AcSh.Range("I2").Resize(LastRow - 1, 1).Value = arrI
    rngDel.EntireRow.Delete
    End If

Edit: Thanks to the comments below, I believe I understand now what you are hoping for. I'm pretty sure this isn't the most eloquent way to solve the problem but I think it works. Please try.

    'Declare variables
    Dim AcSh As Worksheet, LastRow As Long, dict As Object
    Dim rngDel As Range, arrE, arrInt, arrI, i As Long, dKey
     
    

    
    Set AcSh = ActiveSheet
    LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
    
    'Remove non-Kede rows and reset LastRow
   ' For i = LastRow + 1 To 2 Step -1
   '     If AcSh.Range("G" & i).Value <> "Kede" Then AcSh.Range("G" & i).EntireRow.Delete
   ' Next i
    LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
    
    arrE = AcSh.Range("E2:E" & LastRow).Value
    arrG = AcSh.Range("G2:G" & LastRow).Value
    Set dict = CreateObject("Scripting.Dictionary")
     
     

    'Sum and delete duplicates
    On Error Resume Next
    For i = 1 To UBound(arrE)
    
        If Not dict.Exists(arrE(i, 1) & arrG(i, 1)) Then
            dict.Add arrE(i, 1) & arrG(i, 1), AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
        ElseIf arrG(i, 1) = "Kede" Then
            arrInt = Split(dict(arrE(i, 1) & arrG(i, 1)), "|")
            dict(arrE(i, 1) & arrG(i, 1)) = arrInt(0) & "|" & CDbl(arrInt(1)) + CDbl(AcSh.Range("I" & i + 1).Value)
            
            If rngDel Is Nothing Then
                Set rngDel = AcSh.Range("E" & i + 1)
            Else
                Set rngDel = Union(rngDel, AcSh.Range("E" & i + 1))
            End If
        Else
            dict.Add AcSh.Range("E" & i + 1).Address, AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
        End If
        
    Next i
     
    On Error Resume Next
    ReDim arrI(1 To LastRow, 1 To 1)

    For Each dKey In dict.keys()
        arrInt = Split(dict.Item(dKey), "|")
        arrI(Range(arrInt(0)).Row - 1, 1) = CDbl(arrInt(1))
    Next
    If Not rngDel Is Nothing Then
        AcSh.Range("I2").Resize(LastRow - 1, 1).Value = arrI
        rngDel.EntireRow.Delete
    End If

Upvotes: 1

Ben Mega
Ben Mega

Reputation: 522

This code is definitely a bit confusing. Essentially, they are making a dictionary with keys from E:E and values from I:I. It may be possible to rework this but may I suggest an easier alternative: pivot tables. They are much more flexible and less likely to break. I put together a mock sheet to show you want it would look like:

Mock Worksheet

To make this yourself to the following:

  1. Select the columns with data (E:I)
  2. Click Insert -> Pivot Table
  3. Drag the header names for columns E:E, G:G, and I:I to where Column1, Column2, and Column3, are in the picture.
  4. Change the filter the Kede

I hope this helps! If you have questions, I'll try my best to help.

Upvotes: 1

Related Questions