Solved Merge cells into one cell

Mstest / Awrdacpi
February 28, 2018 at 17:36:18
Specs: Windows XP, 2 GHz / 958 MB

Can someone help on how we can merge multiple cells into one single cell?
Can this be possible in macro?

Below is the raw data

Supplier No	Supplier Name	    Countries
102205	      ABC Corporation	    US
102205	      ABC Corporation	    ARGENTINA 
102205	      ABC Corporation	    AUSTRALIA 
102205	      ABC Corporation	    BRAZIL 
102205	      ABC Corporation	    CANADA  
102205	      ABC Corporation	    CHINA 
102205	      ABC Corporation	    COLOMBIA 
102205	      ABC Corporation	    UNITED KINGDOM 
102205	      ABC Corporation	    MEXICO 
102205	      ABC Corporation	    POLAND 
103024	      REMBERGER	            GERMANY  
103024	      REMBERGER	            POLAND 
103024	      REMBERGER	            RUSSIAN FEDERATION  
515678	      Fab Limited	    INDIA 
515678	      Fab Limited	    AUSTRALIA 
515678	      Fab Limited	    PHILIPPINES 
515678	      Fab Limited	    MALAYSIA 
515678	      Fab Limited	    CHINA 
111135	      Trading Co	    POLAND 
111135	      Trading Co	    AUSTRALIA 
111135	      Trading Co	    CHINA 
111135	      Trading Co	    UNITED KINGDOM 
111135	      Trading Co	    INDIA 
237573	      Lite Inc	            MALAYSIA 
237573	      Lite Inc	            PHILIPPINES 
237573	      Lite Inc	            CHINA 
237573	      Lite Inc  	    INDIA 

Results should look like this

Supplier No	     Supplier Name	       Countries
103024	             REMBERGER	               GERMANY  ; POLAND ; RUSSIAN FEDERATION  
515678	             Fab Limited	       INDIA ; AUSTRALIA ; PHILIPPINES ; MALAYSIA ; CHINA 
111135	             Trading Co	               POLAND ; AUSTRALIA ; CHINA ; UNITED KINGDOM ; INDIA 
237573	              Lite Inc	               MALAYSIA ; PHILIPPINES : CHINA ; INDIA  

Thanks for the support

message edited by shieldbreakers

See More: Merge cells into one cell

Report •

February 28, 2018 at 17:47:36
I don't quite understand what you are trying to do.

You showed some "raw data" but since there are no column letters or row numbers, we don't really know what that data looks like in a spreadsheet.

We also don't know what you want the results to look like.

Do us a favor. Please click on the How-To link at the end of this post and read the instructions on how to format example data in this forum. Then edit/repost your data so that the columns line up correctly. Don't forget to use Column letters and Row numbers as shown in the example.

Show us both the input (raw data) and the desired output and we'll see what we can do to help.

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code

Report •

March 5, 2018 at 17:24:44
✔ Best Answer
Sorry for the delay in responding. I totally forgot to check and see if you had reposted your data in the proper format. (We don't get any notification if a post is edited)

Anyway, this code should get you what you want. It's not the most elegant method to accomplish your goal, but it gets it done.

Since you didn't include Column letters or Row numbers as requested in my previous post, I have to make some assumptions:

1 - Your table starts in Sheet1!A1
2 - You want your results to start in Sheet2!A1

What the code does is insert a column of Formulas in Sheet1 which concatenates the Country names, row by row, for each group of Suppliers. Once the concatenated strings have been produced, the code loops through the list and copies the last row of each Supplier group to Sheet2. The last row of each group contains the complete concatenated list.

If you use F8 to single step through the code, you can see how it works.

Sub MergeCountries()
Dim nxtRw As Long, srcRw As Long, lastRw As Long

Application.ScreenUpdating = False

 With Sheets(1)

'Populate Sheet1 Column D with formula that builds the Country strings
  lastRw = .Cells(Rows.Count, 1).End(xlUp).Row
  .Columns(4).Insert shift:=xlToLeft
  .Range("D2:D" & lastRw).Formula = "=IF(B2<>B1,C2,D1&"" ; ""&C2)"

'Initialze Sheet2 Row counter
    nxtRw = 1
'Loop through Sheet1 Column B, Copying Row where Supplier Name changes
     For srcRw = 2 To 28
        If .Cells(srcRw, 2) <> .Cells(srcRw + 1, 2) Then
            nxtRw = nxtRw + 1
           .Range(Cells(srcRw, 1), Cells(srcRw, 4)).Copy
           Sheets(2).Cells(nxtRw, 1).PasteSpecial Paste:=xlValues
        End If

'Clean up Sheet1
'Clean up Sheet2
   .Rows(1).EntireRow.Copy Sheets(2).Cells(1, 1) 
 End With
End Sub

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code

Report •
Related Solutions

Ask Question