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.