EXCEL - Merging multiple rows into a single row

[sensey1]

Job Description

I have a spreadsheet that lists all customers, invoice and order numbers, with each order number having a different line, and the customers shown multiple times.

I would like to merge this, so each customer number is shown once, and the order numbers shown in the following cells. I've attached an example sheet.

I've seen various methods explained, but can't figure them out, so I'd appreciate an example if anyone can help.

I think that a person that handles macros can handle it. See the atached EXCEL file for the example.

http://www.polish.ro/probebun.xls

Regards,
Sebastian

 

[storm8]

Hello Sebastian, I dont think (I might be wrong) that you actually want to do this. For any further data manipulation, I suggest you keep each invoice on separate row as they are. if you want to summarize your data, I suggest to use pivotTables instead.

 

[sensey1]

but if i want to put them in separate collums not in separate rows, can i ?

 

[storm8]

what do you mean by separate columns?

My suggestion was to keep the data as they are. if you have them as desired, you "cannot! for example count number of invoices for each customer, sum of costs etc...

 

[MickG]

Try this:-
Results on sheet 3.
At the moment the Results dates are in "Serial Number" format, but if it what you want I'll try and alter the code.

[COLOR=navy]Sub[/COLOR] MG13Jan29
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] AllRw [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] k
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        AllRw = Join(Application.Transpose(Application.Transpose(Dn.Resize(, 14).Value)))
            [COLOR=navy]If[/COLOR] Not .Exists(AllRw) [COLOR=navy]Then[/COLOR]
                .Add AllRw, Dn
            [COLOR=navy]Else[/COLOR]
                [COLOR=navy]Set[/COLOR] .Item(AllRw) = Union(.Item(AllRw), Dn)
            [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
c = 1
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] k [COLOR=navy]In[/COLOR] .keys
 c = c + 1
 Sheets("sheet3").Cells(c, 1).Resize(, 15) = .Item(k).Resize(, 15).Value
 [COLOR=navy]If[/COLOR] .Item(k).Count = 1 [COLOR=navy]Then[/COLOR]
   Sheets("sheet3").Cells(c, 15) = .Item(k).Offset(, 15)
   Sheets("sheet3").Cells(c, 16) = .Item(k).Offset(, 16)
   Sheets("sheet3").Cells(c, 17) = .Item(k).Offset(, 17)
   Sheets("sheet3").Cells(c, 18) = .Item(k).Offset(, 18)
   Sheets("sheet3").Cells(c, 19) = .Item(k).Offset(, 18)
[COLOR=navy]Else[/COLOR]
   Sheets("sheet3").Cells(c, 15) = Join(Application.Transpose(.Item(k).Offset(, 15)), ", ")
   Sheets("sheet3").Cells(c, 16) = Join(Application.Transpose(.Item(k).Offset(, 16)), ", ")
   Sheets("sheet3").Cells(c, 17) = Join(Application.Transpose(.Item(k).Offset(, 17)), ", ")
   Sheets("sheet3").Cells(c, 18) = Join(Application.Transpose(.Item(k).Offset(, 18)), ", ")
   Sheets("sheet3").Cells(c, 19) = Application.Sum(.Item(k).Offset(, 18))
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] k
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[MickG]

Slight mod the Result cells where out of Line!!!

[COLOR="Navy"]Sub[/COLOR] MG13Jan51
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] AllRw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        AllRw = Join(Application.Transpose(Application.Transpose(Dn.Resize(, 14).Value)))
            [COLOR="Navy"]If[/COLOR] Not .Exists(AllRw) [COLOR="Navy"]Then[/COLOR]
                .Add AllRw, Dn
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] .Item(AllRw) = Union(.Item(AllRw), Dn)
            [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys
 c = c + 1
 Sheets("sheet3").Cells(c, 1).Resize(, 15) = .Item(k).Resize(, 15).Value
 [COLOR="Navy"]If[/COLOR] .Item(k).Count = 1 [COLOR="Navy"]Then[/COLOR]
   Sheets("sheet3").Cells(c, 16) = .Item(k).Offset(, 15)
   Sheets("sheet3").Cells(c, 17) = .Item(k).Offset(, 16)
   Sheets("sheet3").Cells(c, 18) = .Item(k).Offset(, 17)
   Sheets("sheet3").Cells(c, 19) = .Item(k).Offset(, 18)
   Sheets("sheet3").Cells(c, 20) = .Item(k).Offset(, 18)
[COLOR="Navy"]Else[/COLOR]
   Sheets("sheet3").Cells(c, 16) = Join(Application.Transpose(.Item(k).Offset(, 15)), ", ")
   Sheets("sheet3").Cells(c, 17) = Join(Application.Transpose(.Item(k).Offset(, 16)), ", ")
   Sheets("sheet3").Cells(c, 19) = Join(Application.Transpose(.Item(k).Offset(, 17)), ", ")
   Sheets("sheet3").Cells(c, 19) = Join(Application.Transpose(.Item(k).Offset(, 18)), ", ")
   Sheets("sheet3").Cells(c, 20) = Application.Sum(.Item(k).Offset(, 18))
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG13Jan21
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] AllRw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ray
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
  [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        AllRw = Join(Application.Transpose(Application.Transpose(Dn.Resize(, 14).Value)))
            [COLOR="Navy"]If[/COLOR] Not .Exists(AllRw) [COLOR="Navy"]Then[/COLOR]
                Ray = Dn.Resize(, 20).Value
                Ray(1, 20) = Dn(, 19)
               .Add AllRw, Ray
            [COLOR="Navy"]Else[/COLOR]
                Q = .Item(AllRw)
                    Q(1, 16) = Q(1, 16) & ", " & Dn(, 16)
                    Q(1, 17) = Q(1, 17) & ", " & Dn(, 17)
                    Q(1, 18) = Q(1, 18) & ", " & Dn(, 18)
                    Q(1, 19) = Q(1, 19) & ", " & Dn(, 19)
                    Q(1, 20) = Q(1, 20) + Dn(, 19)
              .Item(AllRw) = Q
            [COLOR="Navy"]End[/COLOR] If
           
[COLOR="Navy"]Next[/COLOR]
Sheets("Sheet3").Range("A2").Resize(.Count, 20) = Application.Transpose(Application.Transpose(.items))
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick