How to combine similiar rows

**minimacros** · 07-09-2010, 06:04 PM

I have the following table

Area	           Division	Q1	Q2	Q3	Q4
Outside	       001   3434	10	20	30	30
Inside	       001   5555	0	0	0	0
Around	       001   5555	1	0	4	3
Around	       001   5555	1	3	6	1

Sorry about the formatting "001 3434" is one division
I am trying to combine the unique combinations of Area + Division
So the resulting table would be:

Area	           Division	Q1	Q2	Q3	Q4
Outside	       001   3434	10	20	30	30
Inside	       001   5555	0	0	0	0
Around	       001   5555	2	3	10	4

Notice how before there were 2 lines with the same combination of Around and "001 5555". The new table has this line combined and the quarters of data summed.

I was wondering if anyone could help me accomplish this (in terms of a macro, unless there is an easier way, subtotals doesnt work well because I would still have to manually input a lot of data) as it will greatly help me overcome some obstacles in a larger project

**Marcol** · 07-09-2010, 07:49 PM

This might be so much easier if you were to post a sample workbook showing your table as is and the desired result.

**minimacros** · 07-10-2010, 12:28 AM

Sorry for not posting one originally... here you go

**Marcol** · 07-10-2010, 04:55 AM

Try this macro in a standard module.

Sub SumThenReduceList()
    Dim LastRow As Long, RowNo As Long
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
        
    Columns("A:F").Sort Key1:=Worksheets("Sheet1").Range("B1"), _
                        Key2:=Worksheets("Sheet1").Range("A1"), Header:=xlYes

    
    Range("G2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$C$2:$C$" & LastRow & ")"
    Range("H2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$D$2:$D$" & LastRow & ")"
    Range("I2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$E$2:$E$" & LastRow & ")"
    Range("J2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$F$2:$F$" & LastRow & ")"
    With Range("G2:J" & LastRow)
        .FillDown
        .Copy
        Range("C2").PasteSpecial xlPasteValues
        .Clear
    End With
        
    For RowNo = LastRow To 2 Step -1
        If Range("A" & RowNo) = Range("A" & RowNo - 1) Then
            Range("A" & RowNo).EntireRow.Delete
        End If
    Next
    Range("A2").Select
End Sub

Hope this helps

**teylyn** · 07-10-2010, 05:14 AM

You could simply do a pivot table. No code, just a few mouse clicks.

See attached.

**minimacros** · 07-10-2010, 06:32 PM

Hey so the macro works okay but unfortunately I forgot to put in the sample the possibility of having more than one type of the same spending. The attached workbook makes up for this problem.

The current Macro would combine all lines based off the Type of Spending, not the combination of the two (Type of Spending and Dept). I was thinking maybe a SUMIFS instead of the SUMIF, but unfortunately I am on Office2004 and they don't have the SUMIFS.

2 Questions: If I were to be able to use a Windows machine and the SUMIFS statement on excel 07/10 would the following command work (and then replace the rest of the Range formulas..

2nd: What is a good workaround of SUMIFS for older versions of excel? (Question 1 is more important, I am trying to get the new windows version but it isn't that easy)

    Range("M2").Formula = "SUMIFS($C$2:C$" & LastRow & ",$A$2:$A$" & LastRow & ",$A2,$B$2:$B$" & LastRow & ",$B2)"

Here is the original code that I formatted for 10 columns of quarter data

Sub SumThenReduceList()
    Dim LastRow As Long, RowNo As Long
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
        
    Columns("A:L").Sort Key1:=Worksheets("Sheet1").Range("B1"), _
                        Key2:=Worksheets("Sheet1").Range("A1"), Header:=xlYes

    
    Range("M2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$C$2:$C$" & LastRow & ")"
    Range("N2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$D$2:$D$" & LastRow & ")"
    Range("O2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$E$2:$E$" & LastRow & ")"
    Range("P2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$F$2:$F$" & LastRow & ")"
    Range("Q2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$G$2:$G$" & LastRow & ")"
    Range("R2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$H$2:$H$" & LastRow & ")"
    Range("S2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$I$2:$I$" & LastRow & ")"
    Range("T2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$J$2:$J$" & LastRow & ")"
    Range("U2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$K$2:$K$" & LastRow & ")"
    Range("V2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,$L$2:$L$" & LastRow & ")"
    
    With Range("M2:V" & LastRow)
        .FillDown
        .Copy
        Range("C2").PasteSpecial xlPasteValues
        .Clear
    End With
        
    For RowNo = LastRow To 2 Step -1
        If Range("A" & RowNo) = Range("A" & RowNo - 1) Then
            Range("A" & RowNo).EntireRow.Delete
        End If
    Next
    Range("A2").Select
End Sub

**minimacros** · 07-10-2010, 07:46 PM

Hey, I was able to try the code on my roommates computer and it worked with the addition noted above. Thanks for the help... hopefully we will switch over soon!

**Marcol** · 07-10-2010, 08:22 PM

Might be an idea to try this

Sub SumThenReduceList()
    Dim LastRow As Long, RowNo As Long
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
        
    Columns("A:L").Sort Key1:=Worksheets("Sheet1").Range("B1"), _
                        Key2:=Worksheets("Sheet1").Range("A1"), Header:=xlYes
    
    Range("M2").Formula = "=SUMIF($A$2:$A$" & LastRow & ",$A2,C$2:C$" & LastRow & ")"
    Range("M2:V2").FillRight
    
    With Range("M2:V" & LastRow)
        .FillDown
        .Copy
        Range("C2").PasteSpecial xlPasteValues
        .Clear
    End With
        
    For RowNo = LastRow To 2 Step -1
        If Range("A" & RowNo) = Range("A" & RowNo - 1) Then
            Range("A" & RowNo).EntireRow.Delete
        End If
    Next
    Range("A2").Select

End Sub