Excel- Macro for combining multiple rows of data

Hi,

This macro is way more complex than the ones I am used to. Do i simply copy and paste this exact formula and run it on the sheet?

Thanks again

Hi,

Create a Pivot Table.

Most people will tell you to simply pivot the data but here is a VBA sub procedure that accomplishes the same result in an independent data matrix.

This will create a new worksheet (first in the worksheet queue) tha holds aggreagted amounts.

Option Explicit

Sub aggregate_data()

    Dim i As Long, k As String, arrH As Variant, delim As String

    Dim dict As Object

    'assign a delimiter character for concatenated dictionary keys

    delim = Chr(9)  'under normal circumstances, Chr(9) (the TAB character) should

                    'never be within a cell's contents

    'create a scripting dictionary object

    Set dict = CreateObject("scripting.dictionary")

    'set dictionary for non-case-sensitive compare

    dict.CompareMode = vbTextCompare

    'refernce the sourceworksheet

    With Worksheets("sheet1")   '<~~ ASSIGN THE CORRECT SOURCE WORKSHEET NAME!!

        'collect the column header labels into a target array

        arrH = .Range(.Cells(1, "A"), .Cells(1, .Columns.Count).End(xlToLeft)).Value2

        'populate dictionary with columns A:F (concatenated) while storing first row number

        For i = .Cells(.Rows.Count, "A").End(xlUp).Row To 2 Step -1

            'construct tabbed concatenated string from columns A:F

            k = Join(Array(.Cells(i, "A").Value2, .Cells(i, "B").Value2, .Cells(i, "C").Value2, _

                    .Cells(i, "D").Value, .Cells(i, "E").Value, .Cells(i, "F").Value), delim)

            'create/adjust concatenated dictionary key with item as aggregated amount

            dict.Item(k) = dict.Item(k) + .Cells(i, UBound(arrH, 2))

        Next i

    End With

    'create a new worksheet

    With Worksheets.Add(before:=Sheets(1))

        'populate the column text labels

        .Cells(1, "A").Resize(UBound(arrH, 1), UBound(arrH, 2)) = arrH

        'populate column A with concatenated keys

        .Cells(2, "A").Resize(dict.Count, 1) = Application.Transpose(dict.Keys)

        'split concatenated key text to columns on delimiter

        With .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))

            .TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _

                    Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _

                    Other:=True, OtherChar:=delim, _

                    FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), _

                      Array(4, 3), Array(5, 3), Array(6, 3))

        End With

        'populate amount column with dictionary items as aggregated amounts

        .Cells(1, .Columns.Count).End(xlToLeft).Offset(1, 0).Resize(dict.Count, 1) = _

            Application.Transpose(dict.Items)

        'format the dates to ease proofing

        .Range(.Cells(2, "D"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 5)).NumberFormat = "[color13]dd-mmm-yyyy_)"

    End With

End Sub

If you have a reasonably large number of entries (>50K), you might wish to work completely within variant arrays to save a few seconds.

Thanks for the reply,

I would like it to be consolidated in the same format as shown below:

Thanks

Hi JDeM22

And how you want the output to look like?

And where?

On a specific sheet?

On a new sheet,

On the same sheet?