Excel Macro: combine selected rows [Solved/Closed]

Report
-
iietntech
Posts
2
Registration date
Thursday December 5, 2013
Status
Member
Last seen
December 6, 2013
-
Hello,

I have source data in Excel looking like this:

CustomerID SalesMonth SalesAmount
12345 Jan 150
12345 Mar 100
12345 Apr 200
56789 Jan 800
56789 May 10
78945 Nov 20
44444 Jan 1000
....

The combination of CustomerID and SalesMonth is unique.

And I would like to combine the source data in a different Excel tab in a form like this:


CustomerID 1stMonth 1stAmount 2ndMonth 2ndAmount 3rdMonth 3rdAmount
12345 Jan 150 Mar 100 Apr 200
56789 Jan 800 May 10
78945 Nov 20
44444 Jan 1000


In total there can be up to 10 different months for a customer (some have only 1 or 2). Important is that there are no 'gaps' in any of the output rows, eg if a customer has sales only in Nov, then the '1stMonth' cell should read 'Nov' for that customer.

Any help on this would be highly appreciated.

4 replies

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
789
try this macro and see sheet 2(copy data in sheet 1 to sheet 3 as safety precaution)

Sub test()
Dim customer As Range, ddata() As Range, custunq As Range, cunq As Range, filt As Range
Dim dest As Range, j As Long, k As Long
With Worksheets("sheet1")
Set customer = Range(.Range("A1"), .Range("A1").End(xlDown))
Set custunq = .Range("A1").End(xlDown).Offset(5, 0)
customer.AdvancedFilter xlFilterCopy, , custunq, True
Set custunq = Range(custunq.Offset(1, 0), custunq.End(xlDown))
For Each custunq In custunq
.Range("A1").CurrentRegion.AutoFilter field:=1, Criteria1:=custunq.Value
Set filt = .Range("A1").CurrentRegion.Offset(1, 0).Resize(Rows.Count - 1, Columns.Count). _
    SpecialCells(xlCellTypeVisible)
  j = WorksheetFunction.CountA(filt.Columns(1))
  'MsgBox j
  ReDim ddata(1 To j)
  With Worksheets("sheet2")
  Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest = filt(1, 1)
End With
  For k = 1 To j
   Set ddata(k) = .Range(filt(k, 2), filt(k, 3))
   ddata(k).Copy
   With Worksheets("sheet2")
.Cells(dest.Row, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
End With
Next k
.Range("A1").CurrentRegion.AutoFilter
Next custunq
Range(.Range("a1").End(xlDown).Offset(1, 0), .Cells(Rows.Count, "A").End(xlUp)).EntireRow.Delete

End With
End Sub


Sub undo()
Worksheets("sheet2").Cells.Clear
End Sub
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 5484 users have said thank you to us this month

Hello venkat1926,
Thanks so much - this does exactly what I needed!
iietntech
Posts
2
Registration date
Thursday December 5, 2013
Status
Member
Last seen
December 6, 2013

How can I alter this macro to display the entire row instead of 2 fields?
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
756
You would need a macro for that. The approach in macro would depend on number of customers that one can encounter
Hello,

The solution proposed works perfectly - but I cant adjust it to contain also ProductIDs.... how could this be done?
One option would be to merge CutsomerID and ProductID in the source data, run the macro and then separate source CustomerID and ProductID again (customerID has each time 8 digits, ProductID each time 4
Source data:
CustomerID ProductID SalesMonth SalesAmount
12345 A Jan 150
12345 A Mar 100
12345 A Apr 200
12345 B Mar 150
12345 B Apr 100
12345 B Jul 200
56789 B Jan 800
56789 B May 10
78945 A Nov 20
44444 C Jan 1000
....
The combination of CustomerID, Product ID and SalesMonth is unique.
And I would like to combine the source data in a different Excel tab in a form like this:
CustomerID ProductID 1stMonth 1stAmount 2ndMonth 2ndAmount 3rdMonth 3rdAmount
12345 A Jan 150 Mar 100 Apr 200
12345 B Mar 150 Apr 100 Jul 200
56789 B Jan 800 May 10
78945 A Nov 20
44444 C Jan 1000


Appreciate your help again,

Many thanks
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
789
IN column E concatenate the four columns or even whatever column you want and then run macro with one modification in this statement

Set customer = Range(.Range("A1"), .Range("A1").End(xlDown))

change A1 to E1(2 places )

once macro is run successfully you can even delete the column E

see whether any other modification is required.