Menu

Excel - A macro to group by column & sum values

Ask a question
The Microsoft Office Software comprises Microsoft Excel which is a spreadsheet application featuring graphic tables, calculations, a macro programming language, called VBA (Visual Basics for Applications) and pivot tables. A pivot table is used to list data; it recognizes and summarizes that data to obtain specified results. A macro represents a list of commands or actions to make lengthy data or repetitive tasks in Excel Office Software faster; this can be run whenever you need to perform the task. It takes the values, performs the required operation and returns the value accordingly. If you want to write a macro to group by column and sum value then just start the macro by using the relevant commands.


Issue


I need to write a macro for the following example: 


Item Qty Length    
A 1 100    
A 1 100    
B 2 200    
B 1 100    
B 5 100    
C 4 200    
C 2 100    
C 1 200    
C 3 100



Basically I want to group by Column A (i.e. Item) and Column C (i.e. length) and also want to add the total of each change in lengths, for an item. In this case, the result on the new sheet would be as below: 


Item Qty Length    
A 2 100    
B 2 200    
B 6 100    
C 5 200    
C 5 100


Hope this make sense.

Can anyone help me write an Excel macro for this please?

Solution


Try this
Assumption:
  • 1. When you start a macro, the sheet from where the data is to be copied from, is the active sheet
  • 2. An empty cell in column A indicates the end of the data
  • 3. You want to paste to sheet 3 (correct in macro if that is not the case) 



Sub consolidateData()   

Dim lRow As Long   
Dim ItemRow1, ItemRow2 As String   
Dim lengthRow1, lengthRow2 As String   

    Columns("A:C").Select   
    Selection.Copy   
       
    Sheets("Sheet3").Select   
       
    Range("A1").Select   
    ActiveSheet.Paste   
       
    Cells.Select   
    Selection.Sort _   
        Key1:=Range("A2"), Order1:=xlAscending, _   
        Key2:=Range("C2"), Order2:=xlDescending, _   
        Header:=xlYes, OrderCustom:=1, _   
        MatchCase:=False, Orientation:=xlTopToBottom, _   
        DataOption1:=xlSortNormal   
           
    lRow = 2   
    Do While (Cells(lRow, 1) <> "")   
           
        ItemRow1 = Cells(lRow, "A")   
        ItemRow2 = Cells(lRow + 1, "A")   
           
        lengthRow1 = Cells(lRow, "C")   
        lengthRow2 = Cells(lRow + 1, "C")   
           
        If ((ItemRow1 = ItemRow2) And (lengthRow1 = lengthRow2)) Then   
            Cells(lRow, "B") = Cells(lRow, "B") + Cells(lRow + 1, "B")   
            Rows(lRow + 1).Delete   
       
        Else   
            lRow = lRow + 1   
        End If   
    Loop   
End Sub

Note


Thanks to rizvisa1 for this tip on the forum.
Jean-François Pillou

Jean-François Pillou - Founder of CCM
Better known as Jeff, Jean-François Pillou is the founder of CommentCaMarche.net. He is also CEO of CCM Benchmark and digital director at the Figaro Group.

Learn more about the CCM team

Related