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?
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