CODEWITHSUNDEEP
vbaexcelgrouping
Aleks Dok
Aleks Dok

Reputation: 13

Macro to group data by month

I'm trying to create a macro that will group data by month: for example, if there are 3 entries for February for client A, then it will consolidate the three entries into one and sum the amounts.

I have:

A: Client name

B: Invoice number

C: Billing month

D: Currency

E: Charge amount

F: Invoice step

Column titles here

What I am trying to do, is group the following into a single row, with the invoice amounts added up, and replace the three rows with just the one row. These entries are for a single client (so the grouping depends on the value in column A).

Example of entries here

EG. Client A has three entries for Jan, Client B has one, Client C has one. Then for February Client A has one, Client B has one and Client C has two.

Any macro suggestions I've seen on here haven't been helpful to me, I keep getting errors coming up so I don't know what the problem is. This is the one I tried:

Sub Group()

Dim e As Range, a as Range

Set e = Range("C6")
Set c = e.Offset(, 2)

Do
If Evaluate("=month(" & e.Address & ")") <> Evaluate("=month(" & e(2).Address & ")") Then
    e(2).Resize(2, 3).Insert
    e(2).Offset(, 2) = "=sum(" & Range(a, c.Offset(, 2)).Address & ")"
    e(2).Offset(, 2).Font.Bold = 1
    Set e = e.End(4)
    Set c = e.Offset(, 2)
Else
    Set e = e(2)
End If
Loop Until e.End(4).Row = Rows.Count

e(2).Offset(, 2) = "=sum(" & Range(c, e.Offset(, 2)).Address & ")"
e(2).Offset(, 2).Font.Bold = 1

End Sub

EDIT: Subtotals and pivot tables would not work - the raw data is pasted in (thousands of lines of entry, for 40+ clients and some have many invoices each month), the raw data is sorted using a macro, which is then pasted into other sheets. Pasting from the pivot would be more difficult.

Upvotes: 0

Views: 2524

Answers (1)

manu
manu

Reputation: 942

I follow your image to write the code: enter image description here

After the code:

enter image description here

Here is the code: 

Sub TEST()
Dim lastrow As Long

lastrow = Range("A" & Rows.Count).End(xlUp).Row



For i = 6 To lastrow

lastrow = Range("A" & Rows.Count).End(xlUp).Row

    For j = i + 1 To lastrow

            If Range("A" & j) = Range("A" & i) And Range("C" & j) = Range("C" & i) Then

                Range("B" & i) = Range("B" & i) & "," & " " & Range("B" & j)
                Range("E" & i) = Range("E" & i).Value + Range("E" & j).Value
                Rows(j).EntireRow.Delete

            End If

    Next j

Next i



End Sub

Upvotes: 1

Related Questions