Macro to re-create concatenated column based on data in multiple colums

[dougebowl]

I have a spreadsheet containing data in Columns say A - O. Column A contains a list of values, Columns B - O contains lists of values which correspond to the list in column A. I am looking for a way (either formula or macro) to concatenate all these values into a separate column (Q). All columns contain headers, so the values begin in row 2. There are a different number of values for each column (B - O).

• So, the first value in column A will need to be concatenated with a "/" delimiter to all the values in column B, the result posted in column Q beginning on row 2
• Then, the second value in column A will need to be concatenated with a "/" delimiter to all the values in column C, these results posted in column Q beginning on next blank row (after the results from the first concatenation)
• Then, continue this pattern until all the values in column A have been concatenated with a "/" delimiter to all the corresponding values in columns D - O and the results a single list in column Q

Thanks in advance for all the help. I truly enjoy this forum to make my life easier and appreciate the willingness of folks to help out.

Please let me know if any questions to clarify my request.

Regards,
Doug

 

[mumps]

This would mean that you have 14 values in column A. Is this correct? Would you also have 14 values in columns B to O?

 

[dougebowl]

This would mean that you have 14 values in column A. Is this correct? Would you also have 14 values in columns B to O?

I could have any number of values in column A. But, if I have 4,I would have corresponding values in columns B - E. The number of columns with the values needing to be concatenated will always equal the number of values in column A. The number of values in column B - ? Could vary. So column B might have 4 values, where the number of values in column C might have 6 values.

 

[mumps]

Try:

Sub concatCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, lRow As Long, rng As Range, x As Long: x = 2
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For Each rng In Range("A2:A" & LastRow)
        lRow = Columns(x).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Range("Q" & x) = rng & "|" & Join(Application.Transpose(ActiveSheet.Range(Cells(2, x), Cells(lRow, x)).Value), "|")
        x = x + 1
    Next rng
    Application.ScreenUpdating = True
End Sub