A few words of thanks would be greatly appreciated.

Excel - A macro to group by column & sum values

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
Solution
Note

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