View Full Version : [SOLVED:] VBA macro for combining several cells into one
geomano
04-05-2017, 05:41 AM
Hi, I have a VBA macro for combining values from some columns into one. Now, what I would like to add is an option to combine those values into one cell with some spacing between lines, provided they have the same number in column A.
So that's my raw data:
18856
Now, I run my macro to combine the columns:
18857
And that's the final outcome, I would like to achieve:
18858
I am attaching my spreadsheet for your reference.
Thank you for your help.
Option Explicit
Sub test()
Dim r As Range
Dim s As String
For Each r In Cells(1).CurrentRegion.Columns("G:I").Rows
s = s & vbLf & Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(r)))
Next
MsgBox Mid(s, 2)
End Sub
mdmackillop
04-05-2017, 11:53 AM
If your data has a header row, you should show it in your example.
This assume an ordered list of differing numbers in Column A.
Using Mana's Join code but the loop seems clumsy here. Surely a better way.
Sub test()
Dim dic, d
Dim r As Range
Dim i As Long
Dim s As String
Rows(1).Insert
Cells(1, 1) = "TempHeader"
Set dic = CreateObject("Scripting.Dictionary")
Set r = Sheet1.Cells(1, 1).CurrentRegion.Columns(1).Cells
On Error Resume Next
For i = 2 To r.Cells.Count - 1
dic.Add CStr(r(i)), CStr(r(i))
Next
On Error GoTo 0
For Each d In dic
Columns(1).AutoFilter 1, d
For Each r In Cells(1).CurrentRegion.Columns("G:I").Rows
If r.Hidden = False Then
s = s & vbLf & Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(r)))
End If
Next
Columns(1).Find(d).Offset(, 10) = s
s = ""
Next d
Columns(1).AutoFilter
Rows(1).Delete
End Sub
geomano
04-05-2017, 10:00 PM
Thank you so much, that's precisely what I tried to create!
mike7952
04-07-2017, 06:08 PM
Another way with out a loop. I Posted solution here https://www.excelforum.com/excel-programming-vba-macros/1180405-vba-macro-for-combining-several-cells-into-one.html#post4623106
Sub Concat()
Dim txt As String
With Sheets(2)
With .Range("i1", .Cells(Rows.Count, "i").End(xlUp))
.Offset(, 1).Value = "=RC[-3] & "" "" & RC[-2] & "" "" & RC[-1]"
.Offset(, 1).Value = .Offset(, 1).Value
txt = Join(Application.Transpose(.Offset(, 1).Value), vbNewLine)
End With
.[k1] = txt
End With
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.