Sum Duplicate Values Based on 3 columns with VBA

[osinrider04]

I have a data set where the combination of 3 columns needs to be consolidated, and then their values summed. Here is a pretend scenario: I have Employee Name, Contract Number, Task Number. Right now the data is built by a daily entry of these inputs. This means an employee will have many entries per day if they are working on numerous contracts and tasks. What I would like to do is remove duplicates of these 3 columns (which I have done in my VBA already), but I also want to sum the values of these combinations before deleting the duplicates.

My code at the moment is only good enough to delete the entries and keep only non-dupes. The obvious problem is that once I have removed dupes I can no longer get my summation of the values that were there before. It might be worth noting that my data will always be changing. The names of employees, contract numbers, and task numbers will be expanding and changing.

Essentially I will take a repository of data and create a whole new tab with this consolidated list of entries.

Sub Dedupe()


Application.ScreenUpdating = False
Dim lastrow As Long


With ThisWorkbook.Worksheets("SubInvBackUpCopied (2)")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastrow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lastrow = 1
End If


'Array(4, 5, 7, 8) means 4 for D, 5 for E, and 8 for H
.Range("A1:P" & lastrow).RemoveDuplicates Columns:=Array(4, 5, 8), _
Header:=xlYes
End With


Application.ScreenUpdating = True

 

[Roderick_E]

maybe a sumifs BEFORE removing the duplicates?

 

[osinrider04]

The issue with the sumifs is that I am inserting a formula into many columns, and for however many rows of data now exist after the deduplication. The sumifs also has to match on numerous fields in order for it to sum properly. I'm afraid that after a few months of use, the size of the file will be expanding rapidly because of the insertion of these formulas. Do you have any idea how to prevent this? Also, I am using the Range("A2").Formula = " " to insert my sumifs. I'm sure this is not the best practice so let me know if an R1C1 formula should be used instead.

 

[tuyendungcstoph]

I have a data set where the combination of 3 columns needs to be consolidated, and then their values summed. Here is a pretend scenario: I have Employee Name, Contract Number, Task Number. Right now the data is built by a daily entry of these inputs. This means an employee will have many entries per day if they are working on numerous contracts and tasks. What I would like to do is remove duplicates of these 3 columns (which I have done in my VBA already), but I also want to sum the values of these combinations before deleting the duplicates.

My code at the moment is only good enough to delete the entries and keep only non-dupes. The obvious problem is that once I have removed dupes I can no longer get my summation of the values that were there before. It might be worth noting that my data will always be changing. The names of employees, contract numbers, and task numbers will be expanding and changing.

Essentially I will take a repository of data and create a whole new tab with this consolidated list of entries.

Sub Dedupe()


Application.ScreenUpdating = False
Dim lastrow As Long


With ThisWorkbook.Worksheets("SubInvBackUpCopied (2)")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastrow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lastrow = 1
End If


'Array(4, 5, 7, 8) means 4 for D, 5 for E, and 8 for H
.Range("A1:P" & lastrow).RemoveDuplicates Columns:=Array(4, 5, 8), _
Header:=xlYes
End With


Application.ScreenUpdating = True

you should be remove duplicate first after that using sumif for summation task number. you can try with below code.

Sub Fil_Data()
 
    Dim vaData As Variant
    Dim colUnique As Collection
    Dim aOutput() As Variant
    Dim i As Long
 
    Dim LastRow As Long
    LastRow = Sheet2.cells(Rows.Count, 1).End(xlUp).Row
         
 
    vaData = Sheet4.Range("F:F" & LastRow).Value
    Set colUnique = New Collection
 
   getSpeed (True)
 
    For i = LBound(vaData, 1) To UBound(vaData, 1)
        On Error Resume Next
            colUnique.Add vaData(i, 1), CStr(vaData(i, 1))
        On Error GoTo 0
    Next i
 
    ReDim aOutput(1 To colUnique.Count, 1 To 1)
 
    For i = 1 To colUnique.Count
                aOutput(i, 1) = colUnique.Item(i)
    Next i
           
    Sheet1.Range("A2").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
   
      For i = 5 To Sheet1.cells(Rows.Count, 1).End(xlUp).Row
                cells(i, "B") = Application.sumIfs(sheet2.range(“A:A”),cells(i,”A”),Sheet2.range(“C:C”))
       Next i
 
getSpeed (False)
End If
 
End Sub
 
Function getSpeed(doIt As Boolean)
    Application.ScreenUpdating = Not (doIt)
    Application.EnableEvents = Not (doIt)
    Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function