CODEWITHSUNDEEP
vbaexcelduplicates
zaanwar
zaanwar

Reputation: 65

Excel: Adding one field of duplicate rows and deleting duplicate rows

I have a lot of data that is pulled from a company tool, and I need help with duplicate rows. I am fairly new to VBA and Excel so please bear with me.

There are four columns:

Account | Project | Device | Volume

I need help writing a macro that does the following in this order:

  1. Compares the account name in the first row to the next row.
  2. If the account names are the same, it compares the two project names.
  3. If the project names are the same, it compares the two device names.
  4. If the device names are the same, it adds the volumes and deletes the second row.
  5. It repeats this until it has reached the bottom of the data.

Here is an example of what it should look like:

STARTING DATA:

enter image description here

The final data should look like this:

enter image description here

Any help you can offer would be wonderful. Thank you!

Upvotes: 1

Views: 562

Answers (2)

Elbert Villarreal
Elbert Villarreal

Reputation: 1716

This code should help....

Sub likePivot()
Dim r
Dim i As Range
Dim j
Dim rng As Range
Dim Comp
Dim Proj
Dim Devi
Dim A
Dim B
Dim C
Dim D
    A = 1
    B = 2
    C = 3
    D = 4
    r = Range("A2").End(xlDown).Row 'This is to know the end of the data
    j = 1 'just an index
    Do
        j = j + 1
        Comp = Cells(j, A).Value 'This is justo to set the code clear (the IF's)
        Proj = Cells(j, B).Value
        Devi = Cells(j, C).Value
        If Comp = Empty Then Exit Sub 'If reach the end of the data, exit
        If Comp = Cells(j + 1, A) Then 'if the company is equal to the next one
            If Proj = Cells(j + 1, B) Then 'If the Project is equal to the next one
                If Devi = Cells(j + 1, C) Then 'If the Device is equal to the next one
                        Cells(j, D).Value = Cells(j, D).Value + Cells(j + 1, D).Value 'Add the value of the next one
                        Cells(j + 1, D).EntireRow.Delete 'Delete the next line.
                        j = j - 1
                End If
            End If
        End If
    Loop While Comp <> 0 'If the Company row has something, do it again and again until the end of times
End Sub

I think you wanted to delete repeated lines, but if you want to put data in other columns you can tell me and modify the answer.

Edit#1

If you want to see good results it is important to sort all the data from A-Z. Each column begining from the last column.

And added a comment in a line...

Upvotes: 1

Scott Craner
Scott Craner

Reputation: 152585

This will do it:

Sub sumdevice()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim cel As Range
Dim lstRow As Long

Set ws = Sheets("Sheet11") 'change this to your sheet name
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(ws.Rows.Count, 3).End(xlUp))

rng.Copy ws.Range("F1")

Set rng2 = ws.Range(ws.Cells(1, 6), ws.Cells(ws.Rows.Count, 8).End(xlUp))
With rng2
    .Value = .Value
    .RemoveDuplicates Array(1, 2, 3), xlYes
End With

ws.Range("I1").Value = "Volume"
lstRow = ws.Range("H" & ws.Rows.Count).End(xlUp).Row

Set rng2 = ws.Range("I2:I" & lstRow)
For Each cel In rng2
    cel.Value = ws.Evaluate("=SUMIFS($D:$D,$A:$A," & cel.Offset(, -3).Address(0, 0) & ",$B:$B," & cel.Offset(, -2).Address(0, 0) & ",$C:$C," & cel.Offset(, -1).Address(0, 0) & ")")
Next cel

End Sub

It basically copies and pastes the data in Columns A-C into F-H, then removes duplicates. Then in column I it puts the value of a SUMIFS() formula.

Upvotes: 1

Related Questions