I'm trying to create a macro to concatenate multiple columns until find an empty cell, when it finds should put the concatenated text in the first cell. The image shows how it should work. In this example I have values from B to M but it can varies. Thank you for your help and time!
Asked
Active
Viewed 830 times
1
-
Will the number of columns be different in different rows as well? Also, will column B a good guess to get a last row value ? – FAB Jun 14 '19 at 20:45
-
1If you have a version of Excel that has `TEXTJOIN`, you can use that. Otherwise you can use a UDF version - an example [here](https://stackoverflow.com/questions/50716550/textjoin-for-xl2010-xl2013-with-criteria). – BigBen Jun 14 '19 at 20:45
2 Answers
0
Give this a try, see comments for more details:
Option Explicit
Sub concatenateValues()
Dim ws As Worksheet: Set ws = ActiveWorkbook.Sheets("Sheet Name") '
Dim lRow As Long: lRow = ws.Cells(Rows.Count, 2).End(xlUp).Row 'get last row at column B
Dim lCol As Long: lCol = ws.Cells(1, Column.Count).End(xlToLeft).Column 'get last column at row 1, assuming you have at least headers
Dim arrData As Variant: arrData = ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol)) 'declare and allocate your data to an array
Dim R As Long, C As Long
For R = LBound(arrData) + 1 To UBound(arrData) 'for each row in your data, start at row 2
For C = LBound(arrData, 2) + 1 To UBound(arrData, 2) 'for each column in your data, start at column 2
arrData(R, 1) = arrData(R, 1) & arrData(R, C) 'concatenate the values
Next C
Next R
ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol)) = arrData 'put the values back into the sheet
End Sub

FAB
- 2,505
- 1
- 10
- 21
0
Here's a VBA solution. I assumed that the second column would always have a value in it.
Sub Concat()
Dim i As Integer, Sht As Worksheet, Str As String
i = 3
Set Sht = ThisWorkbook.Sheets(1) 'Change this to whatever sheet you're using
Str = Sht.Cells(1, 2).Value
Do Until Sht.Cells(1, i).Value = ""
Str = Str & "-" & Sht.Cells(1, i).Value
i = i + 1
Loop
Sht.Cells(1, 1).Value = Str
End Sub

Parker.R
- 88
- 8