Sum columns based on duplicate data macro

Posted on 2016-08-04
Last Modified: 2016-08-07
if data in columns where A=B=C then sum Col D E and F

if i have data as below

Col A      Col B      Col C      Col D      Col E      Col F
123              456               789             0.1               2                 5
123              456               789             0.1               2                 5

Then it should Sum Col D E and F as data in each col of ABC are same.

attached is the file with input and output what i am looking for

found a macro but it has subtotal i do not need subtotal format
Question by:Nirvana
  • 3
  • 2
LVL 33

Expert Comment

by:Rob Henson
ID: 41742174
I have just managed to achieve similar result with a Pivot Table.

See attached.

Author Comment

ID: 41742189
thank you Rob . Ideally i should work however the stakeholder is looking for a specific format. highlighting the repeated or duplicate rows and total to be highlighted in different color

what we can improvise in your solution is that remove sub total for col A and highlight rows with same value
LVL 33

Expert Comment

by:Rob Henson
ID: 41742201
After I posted, I spotted something in your file as well. Is there a reason why the rows with 960 (?) in Col A weren't totalled as they were duplicated.

Can I ask why you don't want to use the SUBTOTAL function? It does what you are trying to do, other than it will add a subtotal row even if there is only a single entry.

Will there be occasions where the entry in col A is duplicated with different values in col B or col C?

Thinking that SUBTOTAL could still be used with some VBA to automate along these lines:

Add column Concatenating Col A, B & C to get unique identifiers
Sort Data on Identifier
Apply Subtotal with a count function on Identifier
Subtotal will insert rows and will add header of "Count of Identifier"
Apply Filter and Filter on "Count of" column for "Count of *" and result column where result = 1
Delete the visible rows to get rid of the rows with single entry subtotal
Do Find and Replace looking for "SUBTOTAL(3," and Replace with "SUBTOTAL(9,"  - for the arguments in the subtotal function 3 does a count and 9 does a sum.
Do Find and Replace for "Count of *" and Replace with "Sum of" or "" to remove.
Apply 2 Conditional Formatting rules:
   1) where count of col A is more than 1 highlight pale green
   2) where col A is blank highlight dark green

Does that sound feasible?

Rob H
DevOps Toolchain Recommendations

Read this Gartner Research Note and discover how your IT organization can automate and optimize DevOps processes using a toolchain architecture.


Author Comment

ID: 41742240
Hi Rob,

I have internally done exactly what you have done. concatenated and created a subtotal. however, to provide it specific leadership team they wanted in specific format o had to put everything in that format copy pasting values and removing subtotals for single values etc., at times people are so concerned about format rather the results.

one other reason could be stakeholders receive the file from different regions if we change the format it will be additional work for them to consolidate

i found some help in the below sites, however unable to puttogether

thank you again for understanding
LVL 30

Accepted Solution

Subodh Tiwari (Neeraj) earned 500 total points
ID: 41743787
Please try this to see if this is what you were trying to achieve.
In the attached, click the button on Output Sheet to get the desired output.
If you have issue downloading and opening the attached workbook due to a temporary bug in the forum, first download and save it on your system and then open it.

Sub ReArrangeData()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long, i As Long
Dim rng As Range, cell As Range
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Output")
sws.Range("A1").CurrentRegion.Copy dws.Range("A1")
key2:=dws.Range("B1"), order2:=xlAscending, key3:=dws.Range("C1"), order3:=xlAscending, Header:=xlGuess
lr = dws.Cells(Rows.Count, 1).End(xlUp).Row
Range("G2:G" & lr).Formula = "=A2&B2&C2"
dws.Range("A1").CurrentRegion.Sort key1:=dws.Range("G1"), order1:=xlAscending, Header:=xlGuess
dws.Range("H2:H" & lr).Formula = "=IF(OR(G2=G3,G2=G1),0,1)"
dws.Range("H1").Value = "Formula"
dws.Range("H2:H" & lr).Value = Range("H2:H" & lr).Value
dws.Range("A1").CurrentRegion.Sort key1:=dws.Range("H1"), order1:=xlAscending, Header:=xlYes
For i = lr To 3 Step -1
    If dws.Cells(i, 7) = dws.Cells(i - 1, 7) And dws.Cells(i, 8) <> 1 Then
        dws.Rows(i + 1).Insert
    End If
Next i
lr = dws.Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each rng In dws.Range("D1:D" & lr).SpecialCells(xlCellTypeConstants).Areas
    If rng.Cells(rng.Rows.Count).Offset(0, 4) = 0 Then
        rng.Cells(rng.Rows.Count).Offset(1, -1) = "Total"
        rng.Cells(rng.Rows.Count).Offset(1, 0) = Application.Sum(rng)
        rng.Cells(rng.Rows.Count).Offset(1, 1) = Application.Sum(rng.Offset(0, 1))
        rng.Cells(rng.Rows.Count).Offset(1, 2) = Application.Sum(rng.Offset(0, 2))
        rng.Cells(rng.Rows.Count).Offset(1, -1).Resize(1, 4).Font.Bold = True
        rng.Offset(0, -3).Resize(rng.Rows.Count, 6).Interior.Color = RGB(146, 208, 80)
        rng.Cells(rng.Rows.Count).Offset(1, -3).Resize(1, 6).Interior.Color = RGB(0, 176, 80)
        rng.Cells(rng.Rows.Count).Offset(1, -3).Resize(1, 2).Borders.LineStyle = xlNone
    End If
Next rng
dws.Rows(1).Interior.ColorIndex = xlNone
Application.ScreenUpdating = True
End Sub

Open in new window


Author Closing Comment

ID: 41746388
just genius

Featured Post

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A long time ago (May 2011), I have written an article showing you how to create a DLL using Visual Studio 2005 to be hosted in SQL Server 2005. That was valid at that time and it is still valid if you are still using these versions. You can still re…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

789 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question