EXCEL - Merging multiple rows into a single row

sensey1

New Member
Joined
Jan 13, 2012
Messages
2
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
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

storm8

Active Member
Joined
Apr 7, 2010
Messages
327
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

New Member
Joined
Jan 13, 2012
Messages
2
but if i want to put them in separate collums not in separate rows, can i ?
 

storm8

Active Member
Joined
Apr 7, 2010
Messages
327
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

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841

ADVERTISEMENT

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.
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
 
Last edited:

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Slight mod the Result cells where out of Line!!!
Code:
[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

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[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
 

Forum statistics

Threads
1,143,654
Messages
5,720,094
Members
422,266
Latest member
Mattyw

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top