Combining/Merging multiple columns of row (loop on rows) with delimiter

P

pratnimk

New Member
Joined
Feb 8, 2017
Messages
10
Hello All

I was looking to create a macro that would combine all column values in one single column using a delimiter (comma)
I have variable column numbers per row

AD
B
CEF

<tbody>
</tbody>






Result:

A, D
B
C, E, F

<tbody>
</tbody>






Please help
Apologies if this has already been asked before

Thanks in advance
P
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
Welcome to the board. The following code assumes your data starts in cell A1 and that the first row defines the last used column and outputs the results next to the last column:
Code: 
Sub Macro1()


    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
    
    x = Cells(Rows.Count, 1).End(xlUp).row
    y = Cells.find(what:="*", after:=Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column + 1
   
    arr = Cells(1, 1).Resize(x, y).Value
        
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = UBound(arr, 2) - 1 To LBound(arr, 2) Step -1
            If LenB(arr(x, y)) > 0 Then arr(x, UBound(arr, 2)) = arr(x, y) & ", " & arr(x, UBound(arr, 2))
        Next y
        arr(x, UBound(arr, 2)) = Left$(arr(x, UBound(arr, 2)), Len(arr(x, UBound(arr, 2))) - 2)
    Next x
    
    Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr
    
End Sub
 
Last edited:
Upvote 0
Hello JackDanIce

Thank you for your prompt reply

The macro you've written does solve my issue :)

However, my columns start from B
and I was wondering if it is possible to get the results in column A
as I will be processing it further

Thanks
P

JackDanIce said:
Welcome to the board. The following code assumes your data starts in cell A1 and that the first row defines the last used column and outputs the results next to the last column:
Code: 
Sub Macro1()


    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
    
    x = Cells(Rows.Count, 1).End(xlUp).row
    y = Cells.find(what:="*", after:=Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column + 1
   
    arr = Cells(1, 1).Resize(x, y).Value
        
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = UBound(arr, 2) - 1 To LBound(arr, 2) Step -1
            If LenB(arr(x, y)) > 0 Then arr(x, UBound(arr, 2)) = arr(x, y) & ", " & arr(x, UBound(arr, 2))
        Next y
        arr(x, UBound(arr, 2)) = Left$(arr(x, UBound(arr, 2)), Len(arr(x, UBound(arr, 2))) - 2)
    Next x
    
    Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr
    
End Sub
Click to expand...
 
Upvote 0
Try:
Code: 
Sub Macro2()

    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
    
    x = Cells(Rows.Count, 2).End(xlUp).row
    y = Cells.find(what:="*", after:=Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column + 1
   
    arr = Cells(1, 1).Resize(x, y).Value
        
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = UBound(arr, 2) To LBound(arr, 2) + 1 Step -1
            If LenB(arr(x, y)) > 0 Then arr(x, LBound(arr, 2)) = arr(x, y) & ", " & arr(x, LBound(arr, 2))
        Next y
        arr(x, LBound(arr, 2)) = Left$(arr(x, LBound(arr, 2)), Len(arr(x, LBound(arr, 2))) - 2)
    Next x
    
    Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr
    
End Sub
 
Last edited:
Upvote 0
pratnimk,

Welcome to the MrExcel forum.

Here is another macro solution for you to consider, that uses two arrays in memory, and, will adjust to the number of raw data rows, and, columns.

Sample raw data in the active worksheet:


Excel 2007
ABCDE
1AD
2B
3CEF
4
Sheet1


And, after the macro:


Excel 2007
ABCDE
1A, DAD
2BB
3C, E, FCEF
4
Sheet1


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code: 
Sub MergeData()
' hiker95, 02/08/2017, ME990036
Dim a As Variant, i As Long, c As Long
Dim o As Variant, lr As Long, lc As Long
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  a = .Range(.Cells(1, 2), .Cells(lr, lc))
  ReDim o(1 To UBound(a, 1), 1 To 1)
  For i = LBound(a, 1) To UBound(a, 1)
    o(i, 1) = a(i, 1)
    For c = LBound(a, 2) + 1 To UBound(a, 2)
      If Not a(i, c) = vbEmpty Then
        o(i, 1) = o(i, 1) & ", " & a(i, c)
      End If
    Next c
  Next i
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).AutoFit
End With
Application.ScreenUpdating = True
End Sub

Then run the MergeData macro.
 
Upvote 0
Hello JackDanIce

I've tried your updated macro
Its working just fine and solves my issue

Thanks a lot

Cheers
P

JackDanIce said:
Try:
Code: 
Sub Macro2()

    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
    
    x = Cells(Rows.Count, 2).End(xlUp).row
    y = Cells.find(what:="*", after:=Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column + 1
   
    arr = Cells(1, 1).Resize(x, y).Value
        
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = UBound(arr, 2) To LBound(arr, 2) + 1 Step -1
            If LenB(arr(x, y)) > 0 Then arr(x, LBound(arr, 2)) = arr(x, y) & ", " & arr(x, LBound(arr, 2))
        Next y
        arr(x, LBound(arr, 2)) = Left$(arr(x, LBound(arr, 2)), Len(arr(x, LBound(arr, 2))) - 2)
    Next x
    
    Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr
    
End Sub
Click to expand...
 
Upvote 0
Hello hiker95

I've tried your macro
and it solves my issue as well

Thank you for your help

Cheers
P

hiker95 said:
pratnimk,

Welcome to the MrExcel forum.

Here is another macro solution for you to consider, that uses two arrays in memory, and, will adjust to the number of raw data rows, and, columns.

Sample raw data in the active worksheet:

Excel 2007
ABCDE
1AD
2B
3CEF
4

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1​



And, after the macro:

Excel 2007
ABCDE
1A, DAD
2BB
3C, E, FCEF
4

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1​



Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code: 
Sub MergeData()
' hiker95, 02/08/2017, ME990036
Dim a As Variant, i As Long, c As Long
Dim o As Variant, lr As Long, lc As Long
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  a = .Range(.Cells(1, 2), .Cells(lr, lc))
  ReDim o(1 To UBound(a, 1), 1 To 1)
  For i = LBound(a, 1) To UBound(a, 1)
    o(i, 1) = a(i, 1)
    For c = LBound(a, 2) + 1 To UBound(a, 2)
      If Not a(i, c) = vbEmpty Then
        o(i, 1) = o(i, 1) & ", " & a(i, c)
      End If
    Next c
  Next i
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).AutoFit
End With
Application.ScreenUpdating = True
End Sub

Then run the MergeData macro.
Click to expand...
 
Upvote 0
pratnimk,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Combine rows based on previous column duplicate data
Replies
2
Views
285
jessiehayden
J
V
  • Solved
simplest way in Excel to combine (merge)
Replies
4
Views
134
Fluff
Fluff
M
  • Question
Stack/Combine multiple columns into one column
Replies
4
Views
173
myall_blues
myall_blues
I
  • Question
Text to columns Fixed With merging two columns with a decimal
Replies
2
Views
106
ItalianPlatinum
I
C
  • Solved
Merge based on Merged area of adjacent columns
Replies
2
Views
706
CodeNewb
C

Forum statistics

Threads
1,216,075
Messages
6,128,665
Members
449,462
Latest member
Chislobog

Share this page

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
Back
Top